Initial import of Perl5. The king is dead; long live the king!

191 files changed, 41734 insertions, 0 deletions

diff --git a/contrib/perl5/ext/B/B.pm b/contrib/perl5/ext/B/B.pm
new file mode 100644
index 0000000..d5137d4
--- /dev/null
+++ b/contrib/perl5/ext/B/B.pm
@@ -0,0 +1,825 @@
+#      B.pm
+#
+#      Copyright (c) 1996, 1997, 1998 Malcolm Beattie
+#
+#      You may distribute under the terms of either the GNU General Public
+#      License or the Artistic License, as specified in the README file.
+#
+package B;
+require DynaLoader;
+require Exporter;
+@ISA = qw(Exporter DynaLoader);
+@EXPORT_OK = qw(byteload_fh byteload_string minus_c ppname
+		class peekop cast_I32 cstring cchar hash threadsv_names
+		main_root main_start main_cv svref_2object
+		walkoptree walkoptree_slow walkoptree_exec walksymtable
+		parents comppadlist sv_undef compile_stats timing_info);
+
+use strict;
+@B::SV::ISA = 'B::OBJECT';
+@B::NULL::ISA = 'B::SV';
+@B::PV::ISA = 'B::SV';
+@B::IV::ISA = 'B::SV';
+@B::NV::ISA = 'B::IV';
+@B::RV::ISA = 'B::SV';
+@B::PVIV::ISA = qw(B::PV B::IV);
+@B::PVNV::ISA = qw(B::PV B::NV);
+@B::PVMG::ISA = 'B::PVNV';
+@B::PVLV::ISA = 'B::PVMG';
+@B::BM::ISA = 'B::PVMG';
+@B::AV::ISA = 'B::PVMG';
+@B::GV::ISA = 'B::PVMG';
+@B::HV::ISA = 'B::PVMG';
+@B::CV::ISA = 'B::PVMG';
+@B::IO::ISA = 'B::PVMG';
+@B::FM::ISA = 'B::CV';
+
+@B::OP::ISA = 'B::OBJECT';
+@B::UNOP::ISA = 'B::OP';
+@B::BINOP::ISA = 'B::UNOP';
+@B::LOGOP::ISA = 'B::UNOP';
+@B::CONDOP::ISA = 'B::UNOP';
+@B::LISTOP::ISA = 'B::BINOP';
+@B::SVOP::ISA = 'B::OP';
+@B::GVOP::ISA = 'B::OP';
+@B::PVOP::ISA = 'B::OP';
+@B::CVOP::ISA = 'B::OP';
+@B::LOOP::ISA = 'B::LISTOP';
+@B::PMOP::ISA = 'B::LISTOP';
+@B::COP::ISA = 'B::OP';
+
+@B::SPECIAL::ISA = 'B::OBJECT';
+
+{
+    # Stop "-w" from complaining about the lack of a real B::OBJECT class
+    package B::OBJECT;
+}
+
+my $debug;
+my $op_count = 0;
+my @parents = ();
+
+sub debug {
+    my ($class, $value) = @_;
+    $debug = $value;
+    walkoptree_debug($value);
+}
+
+# sub OPf_KIDS;
+# add to .xs for perl5.002
+sub OPf_KIDS () { 4 }
+
+sub class {
+    my $obj = shift;
+    my $name = ref $obj;
+    $name =~ s/^.*:://;
+    return $name;
+}
+
+sub parents { \@parents }
+
+# For debugging
+sub peekop {
+    my $op = shift;
+    return sprintf("%s (0x%x) %s", class($op), $$op, $op->ppaddr);
+}
+
+sub walkoptree_slow {
+    my($op, $method, $level) = @_;
+    $op_count++; # just for statistics
+    $level ||= 0;
+    warn(sprintf("walkoptree: %d. %s\n", $level, peekop($op))) if $debug;
+    $op->$method($level);
+    if ($$op && ($op->flags & OPf_KIDS)) {
+	my $kid;
+	unshift(@parents, $op);
+	for ($kid = $op->first; $$kid; $kid = $kid->sibling) {
+	    walkoptree_slow($kid, $method, $level + 1);
+	}
+	shift @parents;
+    }
+}
+
+sub compile_stats {
+    return "Total number of OPs processed: $op_count\n";
+}
+
+sub timing_info {
+    my ($sec, $min, $hr) = localtime;
+    my ($user, $sys) = times;
+    sprintf("%02d:%02d:%02d user=$user sys=$sys",
+	    $hr, $min, $sec, $user, $sys);
+}
+
+my %symtable;
+sub savesym {
+    my ($obj, $value) = @_;
+#    warn(sprintf("savesym: sym_%x => %s\n", $$obj, $value)); # debug
+    $symtable{sprintf("sym_%x", $$obj)} = $value;
+}
+
+sub objsym {
+    my $obj = shift;
+    return $symtable{sprintf("sym_%x", $$obj)};
+}
+
+sub walkoptree_exec {
+    my ($op, $method, $level) = @_;
+    my ($sym, $ppname);
+    my $prefix = "    " x $level;
+    for (; $$op; $op = $op->next) {
+	$sym = objsym($op);
+	if (defined($sym)) {
+	    print $prefix, "goto $sym\n";
+	    return;
+	}
+	savesym($op, sprintf("%s (0x%lx)", class($op), $$op));
+	$op->$method($level);
+	$ppname = $op->ppaddr;
+	if ($ppname =~ /^pp_(or|and|mapwhile|grepwhile|entertry)$/) {
+	    print $prefix, uc($1), " => {\n";
+	    walkoptree_exec($op->other, $method, $level + 1);
+	    print $prefix, "}\n";
+	} elsif ($ppname eq "pp_match" || $ppname eq "pp_subst") {
+	    my $pmreplstart = $op->pmreplstart;
+	    if ($$pmreplstart) {
+		print $prefix, "PMREPLSTART => {\n";
+		walkoptree_exec($pmreplstart, $method, $level + 1);
+		print $prefix, "}\n";
+	    }
+	} elsif ($ppname eq "pp_substcont") {
+	    print $prefix, "SUBSTCONT => {\n";
+	    walkoptree_exec($op->other->pmreplstart, $method, $level + 1);
+	    print $prefix, "}\n";
+	    $op = $op->other;
+	} elsif ($ppname eq "pp_cond_expr") {
+	    # pp_cond_expr never returns op_next
+	    print $prefix, "TRUE => {\n";
+	    walkoptree_exec($op->true, $method, $level + 1);
+	    print $prefix, "}\n";
+	    $op = $op->false;
+	    redo;
+	} elsif ($ppname eq "pp_range") {
+	    print $prefix, "TRUE => {\n";
+	    walkoptree_exec($op->true, $method, $level + 1);
+	    print $prefix, "}\n", $prefix, "FALSE => {\n";
+	    walkoptree_exec($op->false, $method, $level + 1);
+	    print $prefix, "}\n";
+	} elsif ($ppname eq "pp_enterloop") {
+	    print $prefix, "REDO => {\n";
+	    walkoptree_exec($op->redoop, $method, $level + 1);
+	    print $prefix, "}\n", $prefix, "NEXT => {\n";
+	    walkoptree_exec($op->nextop, $method, $level + 1);
+	    print $prefix, "}\n", $prefix, "LAST => {\n";
+	    walkoptree_exec($op->lastop,  $method, $level + 1);
+	    print $prefix, "}\n";
+	} elsif ($ppname eq "pp_subst") {
+	    my $replstart = $op->pmreplstart;
+	    if ($$replstart) {
+		print $prefix, "SUBST => {\n";
+		walkoptree_exec($replstart, $method, $level + 1);
+		print $prefix, "}\n";
+	    }
+	}
+    }
+}
+
+sub walksymtable {
+    my ($symref, $method, $recurse, $prefix) = @_;
+    my $sym;
+    no strict 'vars';
+    local(*glob);
+    while (($sym, *glob) = each %$symref) {
+	if ($sym =~ /::$/) {
+	    $sym = $prefix . $sym;
+	    if ($sym ne "main::" && &$recurse($sym)) {
+		walksymtable(\%glob, $method, $recurse, $sym);
+	    }
+	} else {
+	    svref_2object(\*glob)->EGV->$method();
+	}
+    }
+}
+
+{
+    package B::Section;
+    my $output_fh;
+    my %sections;
+    
+    sub new {
+	my ($class, $section, $symtable, $default) = @_;
+	$output_fh ||= FileHandle->new_tmpfile;
+	my $obj = bless [-1, $section, $symtable, $default], $class;
+	$sections{$section} = $obj;
+	return $obj;
+    }
+    
+    sub get {
+	my ($class, $section) = @_;
+	return $sections{$section};
+    }
+
+    sub add {
+	my $section = shift;
+	while (defined($_ = shift)) {
+	    print $output_fh "$section->[1]\t$_\n";
+	    $section->[0]++;
+	}
+    }
+
+    sub index {
+	my $section = shift;
+	return $section->[0];
+    }
+
+    sub name {
+	my $section = shift;
+	return $section->[1];
+    }
+
+    sub symtable {
+	my $section = shift;
+	return $section->[2];
+    }
+	
+    sub default {
+	my $section = shift;
+	return $section->[3];
+    }
+	
+    sub output {
+	my ($section, $fh, $format) = @_;
+	my $name = $section->name;
+	my $sym = $section->symtable || {};
+	my $default = $section->default;
+
+	seek($output_fh, 0, 0);
+	while (<$output_fh>) {
+	    chomp;
+	    s/^(.*?)\t//;
+	    if ($1 eq $name) {
+		s{(s\\_[0-9a-f]+)} {
+		    exists($sym->{$1}) ? $sym->{$1} : $default;
+		}ge;
+		printf $fh $format, $_;
+	    }
+	}
+    }
+}
+
+bootstrap B;
+
+1;
+
+__END__
+
+=head1 NAME
+
+B - The Perl Compiler
+
+=head1 SYNOPSIS
+
+	use B;
+
+=head1 DESCRIPTION
+
+The C<B> module supplies classes which allow a Perl program to delve
+into its own innards. It is the module used to implement the
+"backends" of the Perl compiler. Usage of the compiler does not
+require knowledge of this module: see the F<O> module for the
+user-visible part. The C<B> module is of use to those who want to
+write new compiler backends. This documentation assumes that the
+reader knows a fair amount about perl's internals including such
+things as SVs, OPs and the internal symbol table and syntax tree
+of a program.
+
+=head1 OVERVIEW OF CLASSES
+
+The C structures used by Perl's internals to hold SV and OP
+information (PVIV, AV, HV, ..., OP, SVOP, UNOP, ...) are modelled on a
+class hierarchy and the C<B> module gives access to them via a true
+object hierarchy. Structure fields which point to other objects
+(whether types of SV or types of OP) are represented by the C<B>
+module as Perl objects of the appropriate class. The bulk of the C<B>
+module is the methods for accessing fields of these structures. Note
+that all access is read-only: you cannot modify the internals by
+using this module.
+
+=head2 SV-RELATED CLASSES
+
+B::IV, B::NV, B::RV, B::PV, B::PVIV, B::PVNV, B::PVMG, B::BM, B::PVLV,
+B::AV, B::HV, B::CV, B::GV, B::FM, B::IO. These classes correspond in
+the obvious way to the underlying C structures of similar names. The
+inheritance hierarchy mimics the underlying C "inheritance". Access
+methods correspond to the underlying C macros for field access,
+usually with the leading "class indication" prefix removed (Sv, Av,
+Hv, ...). The leading prefix is only left in cases where its removal
+would cause a clash in method name. For example, C<GvREFCNT> stays
+as-is since its abbreviation would clash with the "superclass" method
+C<REFCNT> (corresponding to the C function C<SvREFCNT>).
+
+=head2 B::SV METHODS
+
+=over 4
+
+=item REFCNT
+
+=item FLAGS
+
+=back
+
+=head2 B::IV METHODS
+
+=over 4
+
+=item IV
+
+=item IVX
+
+=item needs64bits
+
+=item packiv
+
+=back
+
+=head2 B::NV METHODS
+
+=over 4
+
+=item NV
+
+=item NVX
+
+=back
+
+=head2 B::RV METHODS
+
+=over 4
+
+=item RV
+
+=back
+
+=head2 B::PV METHODS
+
+=over 4
+
+=item PV
+
+=back
+
+=head2 B::PVMG METHODS
+
+=over 4
+
+=item MAGIC
+
+=item SvSTASH
+
+=back
+
+=head2 B::MAGIC METHODS
+
+=over 4
+
+=item MOREMAGIC
+
+=item PRIVATE
+
+=item TYPE
+
+=item FLAGS
+
+=item OBJ
+
+=item PTR
+
+=back
+
+=head2 B::PVLV METHODS
+
+=over 4
+
+=item TARGOFF
+
+=item TARGLEN
+
+=item TYPE
+
+=item TARG
+
+=back
+
+=head2 B::BM METHODS
+
+=over 4
+
+=item USEFUL
+
+=item PREVIOUS
+
+=item RARE
+
+=item TABLE
+
+=back
+
+=head2 B::GV METHODS
+
+=over 4
+
+=item NAME
+
+=item STASH
+
+=item SV
+
+=item IO
+
+=item FORM
+
+=item AV
+
+=item HV
+
+=item EGV
+
+=item CV
+
+=item CVGEN
+
+=item LINE
+
+=item FILEGV
+
+=item GvREFCNT
+
+=item FLAGS
+
+=back
+
+=head2 B::IO METHODS
+
+=over 4
+
+=item LINES
+
+=item PAGE
+
+=item PAGE_LEN
+
+=item LINES_LEFT
+
+=item TOP_NAME
+
+=item TOP_GV
+
+=item FMT_NAME
+
+=item FMT_GV
+
+=item BOTTOM_NAME
+
+=item BOTTOM_GV
+
+=item SUBPROCESS
+
+=item IoTYPE
+
+=item IoFLAGS
+
+=back
+
+=head2 B::AV METHODS
+
+=over 4
+
+=item FILL
+
+=item MAX
+
+=item OFF
+
+=item ARRAY
+
+=item AvFLAGS
+
+=back
+
+=head2 B::CV METHODS
+
+=over 4
+
+=item STASH
+
+=item START
+
+=item ROOT
+
+=item GV
+
+=item FILEGV
+
+=item DEPTH
+
+=item PADLIST
+
+=item OUTSIDE
+
+=item XSUB
+
+=item XSUBANY
+
+=back
+
+=head2 B::HV METHODS
+
+=over 4
+
+=item FILL
+
+=item MAX
+
+=item KEYS
+
+=item RITER
+
+=item NAME
+
+=item PMROOT
+
+=item ARRAY
+
+=back
+
+=head2 OP-RELATED CLASSES
+
+B::OP, B::UNOP, B::BINOP, B::LOGOP, B::CONDOP, B::LISTOP, B::PMOP,
+B::SVOP, B::GVOP, B::PVOP, B::CVOP, B::LOOP, B::COP.
+These classes correspond in
+the obvious way to the underlying C structures of similar names. The
+inheritance hierarchy mimics the underlying C "inheritance". Access
+methods correspond to the underlying C structre field names, with the
+leading "class indication" prefix removed (op_).
+
+=head2 B::OP METHODS
+
+=over 4
+
+=item next
+
+=item sibling
+
+=item ppaddr
+
+This returns the function name as a string (e.g. pp_add, pp_rv2av).
+
+=item desc
+
+This returns the op description from the global C op_desc array
+(e.g. "addition" "array deref").
+
+=item targ
+
+=item type
+
+=item seq
+
+=item flags
+
+=item private
+
+=back
+
+=head2 B::UNOP METHOD
+
+=over 4
+
+=item first
+
+=back
+
+=head2 B::BINOP METHOD
+
+=over 4
+
+=item last
+
+=back
+
+=head2 B::LOGOP METHOD
+
+=over 4
+
+=item other
+
+=back
+
+=head2 B::CONDOP METHODS
+
+=over 4
+
+=item true
+
+=item false
+
+=back
+
+=head2 B::LISTOP METHOD
+
+=over 4
+
+=item children
+
+=back
+
+=head2 B::PMOP METHODS
+
+=over 4
+
+=item pmreplroot
+
+=item pmreplstart
+
+=item pmnext
+
+=item pmregexp
+
+=item pmflags
+
+=item pmpermflags
+
+=item precomp
+
+=back
+
+=head2 B::SVOP METHOD
+
+=over 4
+
+=item sv
+
+=back
+
+=head2 B::GVOP METHOD
+
+=over 4
+
+=item gv
+
+=back
+
+=head2 B::PVOP METHOD
+
+=over 4
+
+=item pv
+
+=back
+
+=head2 B::LOOP METHODS
+
+=over 4
+
+=item redoop
+
+=item nextop
+
+=item lastop
+
+=back
+
+=head2 B::COP METHODS
+
+=over 4
+
+=item label
+
+=item stash
+
+=item filegv
+
+=item cop_seq
+
+=item arybase
+
+=item line
+
+=back
+
+=head1 FUNCTIONS EXPORTED BY C<B>
+
+The C<B> module exports a variety of functions: some are simple
+utility functions, others provide a Perl program with a way to
+get an initial "handle" on an internal object.
+
+=over 4
+
+=item main_cv
+
+Return the (faked) CV corresponding to the main part of the Perl
+program.
+
+=item main_root
+
+Returns the root op (i.e. an object in the appropriate B::OP-derived
+class) of the main part of the Perl program.
+
+=item main_start
+
+Returns the starting op of the main part of the Perl program.
+
+=item comppadlist
+
+Returns the AV object (i.e. in class B::AV) of the global comppadlist.
+
+=item sv_undef
+
+Returns the SV object corresponding to the C variable C<sv_undef>.
+
+=item sv_yes
+
+Returns the SV object corresponding to the C variable C<sv_yes>.
+
+=item sv_no
+
+Returns the SV object corresponding to the C variable C<sv_no>.
+
+=item walkoptree(OP, METHOD)
+
+Does a tree-walk of the syntax tree based at OP and calls METHOD on
+each op it visits. Each node is visited before its children. If
+C<walkoptree_debug> (q.v.) has been called to turn debugging on then
+the method C<walkoptree_debug> is called on each op before METHOD is
+called.
+
+=item walkoptree_debug(DEBUG)
+
+Returns the current debugging flag for C<walkoptree>. If the optional
+DEBUG argument is non-zero, it sets the debugging flag to that. See
+the description of C<walkoptree> above for what the debugging flag
+does.
+
+=item walksymtable(SYMREF, METHOD, RECURSE)
+
+Walk the symbol table starting at SYMREF and call METHOD on each
+symbol visited. When the walk reached package symbols "Foo::" it
+invokes RECURSE and only recurses into the package if that sub
+returns true.
+
+=item svref_2object(SV)
+
+Takes any Perl variable and turns it into an object in the
+appropriate B::OP-derived or B::SV-derived class. Apart from functions
+such as C<main_root>, this is the primary way to get an initial
+"handle" on a internal perl data structure which can then be followed
+with the other access methods.
+
+=item ppname(OPNUM)
+
+Return the PP function name (e.g. "pp_add") of op number OPNUM.
+
+=item hash(STR)
+
+Returns a string in the form "0x..." representing the value of the
+internal hash function used by perl on string STR.
+
+=item cast_I32(I)
+
+Casts I to the internal I32 type used by that perl.
+
+
+=item minus_c
+
+Does the equivalent of the C<-c> command-line option. Obviously, this
+is only useful in a BEGIN block or else the flag is set too late.
+
+
+=item cstring(STR)
+
+Returns a double-quote-surrounded escaped version of STR which can
+be used as a string in C source code.
+
+=item class(OBJ)
+
+Returns the class of an object without the part of the classname
+preceding the first "::". This is used to turn "B::UNOP" into
+"UNOP" for example.
+
+=item threadsv_names
+
+In a perl compiled for threads, this returns a list of the special
+per-thread threadsv variables.
+
+=item byteload_fh(FILEHANDLE)
+
+Load the contents of FILEHANDLE as bytecode. See documentation for
+the B<Bytecode> module in F<B::Backend> for how to generate bytecode.
+
+=back
+
+=head1 AUTHOR
+
+Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
+
+=cut
diff --git a/contrib/perl5/ext/B/B.xs b/contrib/perl5/ext/B/B.xs
new file mode 100644
index 0000000..8dbc915
--- /dev/null
+++ b/contrib/perl5/ext/B/B.xs
@@ -0,0 +1,1207 @@
+/*	B.xs
+ *
+ *	Copyright (c) 1996 Malcolm Beattie
+ *
+ *	You may distribute under the terms of either the GNU General Public
+ *	License or the Artistic License, as specified in the README file.
+ *
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#include "INTERN.h"
+
+#ifdef PERL_OBJECT
+#undef op_name
+#undef opargs 
+#undef op_desc
+#define op_name (pPerl->Perl_get_op_names())
+#define opargs (pPerl->Perl_get_opargs())
+#define op_desc (pPerl->Perl_get_op_descs())
+#endif
+
+#ifdef PerlIO
+typedef PerlIO * InputStream;
+#else
+typedef FILE * InputStream;
+#endif
+
+
+static char *svclassnames[] = {
+    "B::NULL",
+    "B::IV",
+    "B::NV",
+    "B::RV",
+    "B::PV",
+    "B::PVIV",
+    "B::PVNV",
+    "B::PVMG",
+    "B::BM",
+    "B::PVLV",
+    "B::AV",
+    "B::HV",
+    "B::CV",
+    "B::GV",
+    "B::FM",
+    "B::IO",
+};
+
+typedef enum {
+    OPc_NULL,	/* 0 */
+    OPc_BASEOP,	/* 1 */
+    OPc_UNOP,	/* 2 */
+    OPc_BINOP,	/* 3 */
+    OPc_LOGOP,	/* 4 */
+    OPc_CONDOP,	/* 5 */
+    OPc_LISTOP,	/* 6 */
+    OPc_PMOP,	/* 7 */
+    OPc_SVOP,	/* 8 */
+    OPc_GVOP,	/* 9 */
+    OPc_PVOP,	/* 10 */
+    OPc_CVOP,	/* 11 */
+    OPc_LOOP,	/* 12 */
+    OPc_COP	/* 13 */
+} opclass;
+
+static char *opclassnames[] = {
+    "B::NULL",
+    "B::OP",
+    "B::UNOP",
+    "B::BINOP",
+    "B::LOGOP",
+    "B::CONDOP",
+    "B::LISTOP",
+    "B::PMOP",
+    "B::SVOP",
+    "B::GVOP",
+    "B::PVOP",
+    "B::CVOP",
+    "B::LOOP",
+    "B::COP"	
+};
+
+static int walkoptree_debug = 0;	/* Flag for walkoptree debug hook */
+
+static opclass
+cc_opclass(OP *o)
+{
+    if (!o)
+	return OPc_NULL;
+
+    if (o->op_type == 0)
+	return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP;
+
+    if (o->op_type == OP_SASSIGN)
+	return ((o->op_private & OPpASSIGN_BACKWARDS) ? OPc_UNOP : OPc_BINOP);
+
+    switch (opargs[o->op_type] & OA_CLASS_MASK) {
+    case OA_BASEOP:
+	return OPc_BASEOP;
+
+    case OA_UNOP:
+	return OPc_UNOP;
+
+    case OA_BINOP:
+	return OPc_BINOP;
+
+    case OA_LOGOP:
+	return OPc_LOGOP;
+
+    case OA_CONDOP:
+	return OPc_CONDOP;
+
+    case OA_LISTOP:
+	return OPc_LISTOP;
+
+    case OA_PMOP:
+	return OPc_PMOP;
+
+    case OA_SVOP:
+	return OPc_SVOP;
+
+    case OA_GVOP:
+	return OPc_GVOP;
+
+    case OA_PVOP:
+	return OPc_PVOP;
+
+    case OA_LOOP:
+	return OPc_LOOP;
+
+    case OA_COP:
+	return OPc_COP;
+
+    case OA_BASEOP_OR_UNOP:
+	/*
+	 * UNI(OP_foo) in toke.c returns token UNI or FUNC1 depending on
+	 * whether parens were seen. perly.y uses OPf_SPECIAL to
+	 * signal whether a BASEOP had empty parens or none.
+	 * Some other UNOPs are created later, though, so the best
+	 * test is OPf_KIDS, which is set in newUNOP.
+	 */
+	return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP;
+
+    case OA_FILESTATOP:
+	/*
+	 * The file stat OPs are created via UNI(OP_foo) in toke.c but use
+	 * the OPf_REF flag to distinguish between OP types instead of the
+	 * usual OPf_SPECIAL flag. As usual, if OPf_KIDS is set, then we
+	 * return OPc_UNOP so that walkoptree can find our children. If
+	 * OPf_KIDS is not set then we check OPf_REF. Without OPf_REF set
+	 * (no argument to the operator) it's an OP; with OPf_REF set it's
+	 * a GVOP (and op_gv is the GV for the filehandle argument).
+	 */
+	return ((o->op_flags & OPf_KIDS) ? OPc_UNOP :
+		(o->op_flags & OPf_REF) ? OPc_GVOP : OPc_BASEOP);
+
+    case OA_LOOPEXOP:
+	/*
+	 * next, last, redo, dump and goto use OPf_SPECIAL to indicate that a
+	 * label was omitted (in which case it's a BASEOP) or else a term was
+	 * seen. In this last case, all except goto are definitely PVOP but
+	 * goto is either a PVOP (with an ordinary constant label), an UNOP
+	 * with OPf_STACKED (with a non-constant non-sub) or an UNOP for
+	 * OP_REFGEN (with goto &sub) in which case OPf_STACKED also seems to
+	 * get set.
+	 */
+	if (o->op_flags & OPf_STACKED)
+	    return OPc_UNOP;
+	else if (o->op_flags & OPf_SPECIAL)
+	    return OPc_BASEOP;
+	else
+	    return OPc_PVOP;
+    }
+    warn("can't determine class of operator %s, assuming BASEOP\n",
+	 op_name[o->op_type]);
+    return OPc_BASEOP;
+}
+
+static char *
+cc_opclassname(OP *o)
+{
+    return opclassnames[cc_opclass(o)];
+}
+
+static SV *
+make_sv_object(SV *arg, SV *sv)
+{
+    char *type = 0;
+    IV iv;
+    
+    for (iv = 0; iv < sizeof(PL_specialsv_list)/sizeof(SV*); iv++) {
+	if (sv == PL_specialsv_list[iv]) {
+	    type = "B::SPECIAL";
+	    break;
+	}
+    }
+    if (!type) {
+	type = svclassnames[SvTYPE(sv)];
+	iv = (IV)sv;
+    }
+    sv_setiv(newSVrv(arg, type), iv);
+    return arg;
+}
+
+static SV *
+make_mg_object(SV *arg, MAGIC *mg)
+{
+    sv_setiv(newSVrv(arg, "B::MAGIC"), (IV)mg);
+    return arg;
+}
+
+static SV *
+cstring(SV *sv)
+{
+    SV *sstr = newSVpv("", 0);
+    STRLEN len;
+    char *s;
+
+    if (!SvOK(sv))
+	sv_setpvn(sstr, "0", 1);
+    else
+    {
+	/* XXX Optimise? */
+	s = SvPV(sv, len);
+	sv_catpv(sstr, "\"");
+	for (; len; len--, s++)
+	{
+	    /* At least try a little for readability */
+	    if (*s == '"')
+		sv_catpv(sstr, "\\\"");
+	    else if (*s == '\\')
+		sv_catpv(sstr, "\\\\");
+	    else if (*s >= ' ' && *s < 127) /* XXX not portable */
+		sv_catpvn(sstr, s, 1);
+	    else if (*s == '\n')
+		sv_catpv(sstr, "\\n");
+	    else if (*s == '\r')
+		sv_catpv(sstr, "\\r");
+	    else if (*s == '\t')
+		sv_catpv(sstr, "\\t");
+	    else if (*s == '\a')
+		sv_catpv(sstr, "\\a");
+	    else if (*s == '\b')
+		sv_catpv(sstr, "\\b");
+	    else if (*s == '\f')
+		sv_catpv(sstr, "\\f");
+	    else if (*s == '\v')
+		sv_catpv(sstr, "\\v");
+	    else
+	    {
+		/* no trigraph support */
+		char escbuff[5]; /* to fit backslash, 3 octals + trailing \0 */
+		/* Don't want promotion of a signed -1 char in sprintf args */
+		unsigned char c = (unsigned char) *s;
+		sprintf(escbuff, "\\%03o", c);
+		sv_catpv(sstr, escbuff);
+	    }
+	    /* XXX Add line breaks if string is long */
+	}
+	sv_catpv(sstr, "\"");
+    }
+    return sstr;
+}
+
+static SV *
+cchar(SV *sv)
+{
+    SV *sstr = newSVpv("'", 0);
+    char *s = SvPV(sv, PL_na);
+
+    if (*s == '\'')
+	sv_catpv(sstr, "\\'");
+    else if (*s == '\\')
+	sv_catpv(sstr, "\\\\");
+    else if (*s >= ' ' && *s < 127) /* XXX not portable */
+	sv_catpvn(sstr, s, 1);
+    else if (*s == '\n')
+	sv_catpv(sstr, "\\n");
+    else if (*s == '\r')
+	sv_catpv(sstr, "\\r");
+    else if (*s == '\t')
+	sv_catpv(sstr, "\\t");
+    else if (*s == '\a')
+	sv_catpv(sstr, "\\a");
+    else if (*s == '\b')
+	sv_catpv(sstr, "\\b");
+    else if (*s == '\f')
+	sv_catpv(sstr, "\\f");
+    else if (*s == '\v')
+	sv_catpv(sstr, "\\v");
+    else
+    {
+	/* no trigraph support */
+	char escbuff[5]; /* to fit backslash, 3 octals + trailing \0 */
+	/* Don't want promotion of a signed -1 char in sprintf args */
+	unsigned char c = (unsigned char) *s;
+	sprintf(escbuff, "\\%03o", c);
+	sv_catpv(sstr, escbuff);
+    }
+    sv_catpv(sstr, "'");
+    return sstr;
+}
+
+#ifdef INDIRECT_BGET_MACROS
+void freadpv(U32 len, void *data)
+{
+    New(666, pv.xpv_pv, len, char);
+    fread(pv.xpv_pv, 1, len, (FILE*)data);
+    pv.xpv_len = len;
+    pv.xpv_cur = len - 1;
+}
+
+void byteload_fh(InputStream fp)
+{
+    struct bytestream bs;
+    bs.data = fp;
+    bs.fgetc = (int(*) _((void*)))fgetc;
+    bs.fread = (int(*) _((char*,size_t,size_t,void*)))fread;
+    bs.freadpv = freadpv;
+    byterun(bs);
+}
+
+static int fgetc_fromstring(void *data)
+{
+    char **strp = (char **)data;
+    return *(*strp)++;
+}
+
+static int fread_fromstring(char *argp, size_t elemsize, size_t nelem,
+			    void *data)
+{
+    char **strp = (char **)data;
+    size_t len = elemsize * nelem;
+    
+    memcpy(argp, *strp, len);
+    *strp += len;
+    return (int)len;
+}
+
+static void freadpv_fromstring(U32 len, void *data)
+{
+    char **strp = (char **)data;
+    
+    New(666, pv.xpv_pv, len, char);
+    memcpy(pv.xpv_pv, *strp, len);
+    pv.xpv_len = len;
+    pv.xpv_cur = len - 1;
+    *strp += len;
+}    
+
+void byteload_string(char *str)
+{
+    struct bytestream bs;
+    bs.data = &str;
+    bs.fgetc = fgetc_fromstring;
+    bs.fread = fread_fromstring;
+    bs.freadpv = freadpv_fromstring;
+    byterun(bs);
+}
+#else
+void byteload_fh(InputStream fp)
+{
+    byterun(fp);
+}
+
+void byteload_string(char *str)
+{
+    croak("Must compile with -DINDIRECT_BGET_MACROS for byteload_string");
+}    
+#endif /* INDIRECT_BGET_MACROS */
+
+void
+walkoptree(SV *opsv, char *method)
+{
+    dSP;
+    OP *o;
+    
+    if (!SvROK(opsv))
+	croak("opsv is not a reference");
+    opsv = sv_mortalcopy(opsv);
+    o = (OP*)SvIV((SV*)SvRV(opsv));
+    if (walkoptree_debug) {
+	PUSHMARK(sp);
+	XPUSHs(opsv);
+	PUTBACK;
+	perl_call_method("walkoptree_debug", G_DISCARD);
+    }
+    PUSHMARK(sp);
+    XPUSHs(opsv);
+    PUTBACK;
+    perl_call_method(method, G_DISCARD);
+    if (o && (o->op_flags & OPf_KIDS)) {
+	OP *kid;
+	for (kid = ((UNOP*)o)->op_first; kid; kid = kid->op_sibling) {
+	    /* Use the same opsv. Rely on methods not to mess it up. */
+	    sv_setiv(newSVrv(opsv, cc_opclassname(kid)), (IV)kid);
+	    walkoptree(opsv, method);
+	}
+    }
+}
+
+typedef OP	*B__OP;
+typedef UNOP	*B__UNOP;
+typedef BINOP	*B__BINOP;
+typedef LOGOP	*B__LOGOP;
+typedef CONDOP	*B__CONDOP;
+typedef LISTOP	*B__LISTOP;
+typedef PMOP	*B__PMOP;
+typedef SVOP	*B__SVOP;
+typedef GVOP	*B__GVOP;
+typedef PVOP	*B__PVOP;
+typedef LOOP	*B__LOOP;
+typedef COP	*B__COP;
+
+typedef SV	*B__SV;
+typedef SV	*B__IV;
+typedef SV	*B__PV;
+typedef SV	*B__NV;
+typedef SV	*B__PVMG;
+typedef SV	*B__PVLV;
+typedef SV	*B__BM;
+typedef SV	*B__RV;
+typedef AV	*B__AV;
+typedef HV	*B__HV;
+typedef CV	*B__CV;
+typedef GV	*B__GV;
+typedef IO	*B__IO;
+
+typedef MAGIC	*B__MAGIC;
+
+MODULE = B	PACKAGE = B	PREFIX = B_
+
+PROTOTYPES: DISABLE
+
+BOOT:
+    INIT_SPECIALSV_LIST;
+
+#define B_main_cv()	PL_main_cv
+#define B_main_root()	PL_main_root
+#define B_main_start()	PL_main_start
+#define B_comppadlist()	(PL_main_cv ? CvPADLIST(PL_main_cv) : CvPADLIST(PL_compcv))
+#define B_sv_undef()	&PL_sv_undef
+#define B_sv_yes()	&PL_sv_yes
+#define B_sv_no()	&PL_sv_no
+
+B::CV
+B_main_cv()
+
+B::OP
+B_main_root()
+
+B::OP
+B_main_start()
+
+B::AV
+B_comppadlist()
+
+B::SV
+B_sv_undef()
+
+B::SV
+B_sv_yes()
+
+B::SV
+B_sv_no()
+
+MODULE = B	PACKAGE = B
+
+
+void
+walkoptree(opsv, method)
+	SV *	opsv
+	char *	method
+
+int
+walkoptree_debug(...)
+    CODE:
+	RETVAL = walkoptree_debug;
+	if (items > 0 && SvTRUE(ST(1)))
+	    walkoptree_debug = 1;
+    OUTPUT:
+	RETVAL
+
+int
+byteload_fh(fp)
+	InputStream    fp
+    CODE:
+	byteload_fh(fp);
+	RETVAL = 1;
+    OUTPUT:
+	RETVAL
+
+void
+byteload_string(str)
+	char *	str
+
+#define address(sv) (IV)sv
+
+IV
+address(sv)
+	SV *	sv
+
+B::SV
+svref_2object(sv)
+	SV *	sv
+    CODE:
+	if (!SvROK(sv))
+	    croak("argument is not a reference");
+	RETVAL = (SV*)SvRV(sv);
+    OUTPUT:
+	RETVAL
+
+void
+ppname(opnum)
+	int	opnum
+    CODE:
+	ST(0) = sv_newmortal();
+	if (opnum >= 0 && opnum < PL_maxo) {
+	    sv_setpvn(ST(0), "pp_", 3);
+	    sv_catpv(ST(0), op_name[opnum]);
+	}
+
+void
+hash(sv)
+	SV *	sv
+    CODE:
+	char *s;
+	STRLEN len;
+	U32 hash = 0;
+	char hexhash[11]; /* must fit "0xffffffff" plus trailing \0 */
+	s = SvPV(sv, len);
+	while (len--)
+	    hash = hash * 33 + *s++;
+	sprintf(hexhash, "0x%x", hash);
+	ST(0) = sv_2mortal(newSVpv(hexhash, 0));
+
+#define cast_I32(foo) (I32)foo
+IV
+cast_I32(i)
+	IV	i
+
+void
+minus_c()
+    CODE:
+	PL_minus_c = TRUE;
+
+SV *
+cstring(sv)
+	SV *	sv
+
+SV *
+cchar(sv)
+	SV *	sv
+
+void
+threadsv_names()
+    PPCODE:
+#ifdef USE_THREADS
+	int i;
+	STRLEN len = strlen(PL_threadsv_names);
+
+	EXTEND(sp, len);
+	for (i = 0; i < len; i++)
+	    PUSHs(sv_2mortal(newSVpv(&PL_threadsv_names[i], 1)));
+#endif
+
+
+#define OP_next(o)	o->op_next
+#define OP_sibling(o)	o->op_sibling
+#define OP_desc(o)	op_desc[o->op_type]
+#define OP_targ(o)	o->op_targ
+#define OP_type(o)	o->op_type
+#define OP_seq(o)	o->op_seq
+#define OP_flags(o)	o->op_flags
+#define OP_private(o)	o->op_private
+
+MODULE = B	PACKAGE = B::OP		PREFIX = OP_
+
+B::OP
+OP_next(o)
+	B::OP		o
+
+B::OP
+OP_sibling(o)
+	B::OP		o
+
+char *
+OP_ppaddr(o)
+	B::OP		o
+    CODE:
+	ST(0) = sv_newmortal();
+	sv_setpvn(ST(0), "pp_", 3);
+	sv_catpv(ST(0), op_name[o->op_type]);
+
+char *
+OP_desc(o)
+	B::OP		o
+
+U16
+OP_targ(o)
+	B::OP		o
+
+U16
+OP_type(o)
+	B::OP		o
+
+U16
+OP_seq(o)
+	B::OP		o
+
+U8
+OP_flags(o)
+	B::OP		o
+
+U8
+OP_private(o)
+	B::OP		o
+
+#define UNOP_first(o)	o->op_first
+
+MODULE = B	PACKAGE = B::UNOP		PREFIX = UNOP_
+
+B::OP 
+UNOP_first(o)
+	B::UNOP	o
+
+#define BINOP_last(o)	o->op_last
+
+MODULE = B	PACKAGE = B::BINOP		PREFIX = BINOP_
+
+B::OP
+BINOP_last(o)
+	B::BINOP	o
+
+#define LOGOP_other(o)	o->op_other
+
+MODULE = B	PACKAGE = B::LOGOP		PREFIX = LOGOP_
+
+B::OP
+LOGOP_other(o)
+	B::LOGOP	o
+
+#define CONDOP_true(o)	o->op_true
+#define CONDOP_false(o)	o->op_false
+
+MODULE = B	PACKAGE = B::CONDOP		PREFIX = CONDOP_
+
+B::OP
+CONDOP_true(o)
+	B::CONDOP	o
+
+B::OP
+CONDOP_false(o)
+	B::CONDOP	o
+
+#define LISTOP_children(o)	o->op_children
+
+MODULE = B	PACKAGE = B::LISTOP		PREFIX = LISTOP_
+
+U32
+LISTOP_children(o)
+	B::LISTOP	o
+
+#define PMOP_pmreplroot(o)	o->op_pmreplroot
+#define PMOP_pmreplstart(o)	o->op_pmreplstart
+#define PMOP_pmnext(o)		o->op_pmnext
+#define PMOP_pmregexp(o)	o->op_pmregexp
+#define PMOP_pmflags(o)		o->op_pmflags
+#define PMOP_pmpermflags(o)	o->op_pmpermflags
+
+MODULE = B	PACKAGE = B::PMOP		PREFIX = PMOP_
+
+void
+PMOP_pmreplroot(o)
+	B::PMOP		o
+	OP *		root = NO_INIT
+    CODE:
+	ST(0) = sv_newmortal();
+	root = o->op_pmreplroot;
+	/* OP_PUSHRE stores an SV* instead of an OP* in op_pmreplroot */
+	if (o->op_type == OP_PUSHRE) {
+	    sv_setiv(newSVrv(ST(0), root ?
+			     svclassnames[SvTYPE((SV*)root)] : "B::SV"),
+		     (IV)root);
+	}
+	else {
+	    sv_setiv(newSVrv(ST(0), cc_opclassname(root)), (IV)root);
+	}
+
+B::OP
+PMOP_pmreplstart(o)
+	B::PMOP		o
+
+B::PMOP
+PMOP_pmnext(o)
+	B::PMOP		o
+
+U16
+PMOP_pmflags(o)
+	B::PMOP		o
+
+U16
+PMOP_pmpermflags(o)
+	B::PMOP		o
+
+void
+PMOP_precomp(o)
+	B::PMOP		o
+	REGEXP *	rx = NO_INIT
+    CODE:
+	ST(0) = sv_newmortal();
+	rx = o->op_pmregexp;
+	if (rx)
+	    sv_setpvn(ST(0), rx->precomp, rx->prelen);
+
+#define SVOP_sv(o)	o->op_sv
+
+MODULE = B	PACKAGE = B::SVOP		PREFIX = SVOP_
+
+
+B::SV
+SVOP_sv(o)
+	B::SVOP	o
+
+#define GVOP_gv(o)	o->op_gv
+
+MODULE = B	PACKAGE = B::GVOP		PREFIX = GVOP_
+
+
+B::GV
+GVOP_gv(o)
+	B::GVOP	o
+
+MODULE = B	PACKAGE = B::PVOP		PREFIX = PVOP_
+
+void
+PVOP_pv(o)
+	B::PVOP	o
+    CODE:
+	/*
+	 * OP_TRANS uses op_pv to point to a table of 256 shorts
+	 * whereas other PVOPs point to a null terminated string.
+	 */
+	ST(0) = sv_2mortal(newSVpv(o->op_pv, (o->op_type == OP_TRANS) ?
+				   256 * sizeof(short) : 0));
+
+#define LOOP_redoop(o)	o->op_redoop
+#define LOOP_nextop(o)	o->op_nextop
+#define LOOP_lastop(o)	o->op_lastop
+
+MODULE = B	PACKAGE = B::LOOP		PREFIX = LOOP_
+
+
+B::OP
+LOOP_redoop(o)
+	B::LOOP	o
+
+B::OP
+LOOP_nextop(o)
+	B::LOOP	o
+
+B::OP
+LOOP_lastop(o)
+	B::LOOP	o
+
+#define COP_label(o)	o->cop_label
+#define COP_stash(o)	o->cop_stash
+#define COP_filegv(o)	o->cop_filegv
+#define COP_cop_seq(o)	o->cop_seq
+#define COP_arybase(o)	o->cop_arybase
+#define COP_line(o)	o->cop_line
+
+MODULE = B	PACKAGE = B::COP		PREFIX = COP_
+
+char *
+COP_label(o)
+	B::COP	o
+
+B::HV
+COP_stash(o)
+	B::COP	o
+
+B::GV
+COP_filegv(o)
+	B::COP	o
+
+U32
+COP_cop_seq(o)
+	B::COP	o
+
+I32
+COP_arybase(o)
+	B::COP	o
+
+U16
+COP_line(o)
+	B::COP	o
+
+MODULE = B	PACKAGE = B::SV		PREFIX = Sv
+
+U32
+SvREFCNT(sv)
+	B::SV	sv
+
+U32
+SvFLAGS(sv)
+	B::SV	sv
+
+MODULE = B	PACKAGE = B::IV		PREFIX = Sv
+
+IV
+SvIV(sv)
+	B::IV	sv
+
+IV
+SvIVX(sv)
+	B::IV	sv
+
+MODULE = B	PACKAGE = B::IV
+
+#define needs64bits(sv) ((I32)SvIVX(sv) != SvIVX(sv))
+
+int
+needs64bits(sv)
+	B::IV	sv
+
+void
+packiv(sv)
+	B::IV	sv
+    CODE:
+	if (sizeof(IV) == 8) {
+	    U32 wp[2];
+	    IV iv = SvIVX(sv);
+	    /*
+	     * The following way of spelling 32 is to stop compilers on
+	     * 32-bit architectures from moaning about the shift count
+	     * being >= the width of the type. Such architectures don't
+	     * reach this code anyway (unless sizeof(IV) > 8 but then
+	     * everything else breaks too so I'm not fussed at the moment).
+	     */
+	    wp[0] = htonl(((U32)iv) >> (sizeof(IV)*4));
+	    wp[1] = htonl(iv & 0xffffffff);
+	    ST(0) = sv_2mortal(newSVpv((char *)wp, 8));
+	} else {
+	    U32 w = htonl((U32)SvIVX(sv));
+	    ST(0) = sv_2mortal(newSVpv((char *)&w, 4));
+	}
+
+MODULE = B	PACKAGE = B::NV		PREFIX = Sv
+
+double
+SvNV(sv)
+	B::NV	sv
+
+double
+SvNVX(sv)
+	B::NV	sv
+
+MODULE = B	PACKAGE = B::RV		PREFIX = Sv
+
+B::SV
+SvRV(sv)
+	B::RV	sv
+
+MODULE = B	PACKAGE = B::PV		PREFIX = Sv
+
+void
+SvPV(sv)
+	B::PV	sv
+    CODE:
+	ST(0) = sv_newmortal();
+	sv_setpvn(ST(0), SvPVX(sv), SvCUR(sv));
+
+MODULE = B	PACKAGE = B::PVMG	PREFIX = Sv
+
+void
+SvMAGIC(sv)
+	B::PVMG	sv
+	MAGIC *	mg = NO_INIT
+    PPCODE:
+	for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic)
+	    XPUSHs(make_mg_object(sv_newmortal(), mg));
+
+MODULE = B	PACKAGE = B::PVMG
+
+B::HV
+SvSTASH(sv)
+	B::PVMG	sv
+
+#define MgMOREMAGIC(mg) mg->mg_moremagic
+#define MgPRIVATE(mg) mg->mg_private
+#define MgTYPE(mg) mg->mg_type
+#define MgFLAGS(mg) mg->mg_flags
+#define MgOBJ(mg) mg->mg_obj
+
+MODULE = B	PACKAGE = B::MAGIC	PREFIX = Mg	
+
+B::MAGIC
+MgMOREMAGIC(mg)
+	B::MAGIC	mg
+
+U16
+MgPRIVATE(mg)
+	B::MAGIC	mg
+
+char
+MgTYPE(mg)
+	B::MAGIC	mg
+
+U8
+MgFLAGS(mg)
+	B::MAGIC	mg
+
+B::SV
+MgOBJ(mg)
+	B::MAGIC	mg
+
+void
+MgPTR(mg)
+	B::MAGIC	mg
+    CODE:
+	ST(0) = sv_newmortal();
+	if (mg->mg_ptr)
+	    sv_setpvn(ST(0), mg->mg_ptr, mg->mg_len);
+
+MODULE = B	PACKAGE = B::PVLV	PREFIX = Lv
+
+U32
+LvTARGOFF(sv)
+	B::PVLV	sv
+
+U32
+LvTARGLEN(sv)
+	B::PVLV	sv
+
+char
+LvTYPE(sv)
+	B::PVLV	sv
+
+B::SV
+LvTARG(sv)
+	B::PVLV sv
+
+MODULE = B	PACKAGE = B::BM		PREFIX = Bm
+
+I32
+BmUSEFUL(sv)
+	B::BM	sv
+
+U16
+BmPREVIOUS(sv)
+	B::BM	sv
+
+U8
+BmRARE(sv)
+	B::BM	sv
+
+void
+BmTABLE(sv)
+	B::BM	sv
+	STRLEN	len = NO_INIT
+	char *	str = NO_INIT
+    CODE:
+	str = SvPV(sv, len);
+	/* Boyer-Moore table is just after string and its safety-margin \0 */
+	ST(0) = sv_2mortal(newSVpv(str + len + 1, 256));
+
+MODULE = B	PACKAGE = B::GV		PREFIX = Gv
+
+void
+GvNAME(gv)
+	B::GV	gv
+    CODE:
+	ST(0) = sv_2mortal(newSVpv(GvNAME(gv), GvNAMELEN(gv)));
+
+B::HV
+GvSTASH(gv)
+	B::GV	gv
+
+B::SV
+GvSV(gv)
+	B::GV	gv
+
+B::IO
+GvIO(gv)
+	B::GV	gv
+
+B::CV
+GvFORM(gv)
+	B::GV	gv
+
+B::AV
+GvAV(gv)
+	B::GV	gv
+
+B::HV
+GvHV(gv)
+	B::GV	gv
+
+B::GV
+GvEGV(gv)
+	B::GV	gv
+
+B::CV
+GvCV(gv)
+	B::GV	gv
+
+U32
+GvCVGEN(gv)
+	B::GV	gv
+
+U16
+GvLINE(gv)
+	B::GV	gv
+
+B::GV
+GvFILEGV(gv)
+	B::GV	gv
+
+MODULE = B	PACKAGE = B::GV
+
+U32
+GvREFCNT(gv)
+	B::GV	gv
+
+U8
+GvFLAGS(gv)
+	B::GV	gv
+
+MODULE = B	PACKAGE = B::IO		PREFIX = Io
+
+long
+IoLINES(io)
+	B::IO	io
+
+long
+IoPAGE(io)
+	B::IO	io
+
+long
+IoPAGE_LEN(io)
+	B::IO	io
+
+long
+IoLINES_LEFT(io)
+	B::IO	io
+
+char *
+IoTOP_NAME(io)
+	B::IO	io
+
+B::GV
+IoTOP_GV(io)
+	B::IO	io
+
+char *
+IoFMT_NAME(io)
+	B::IO	io
+
+B::GV
+IoFMT_GV(io)
+	B::IO	io
+
+char *
+IoBOTTOM_NAME(io)
+	B::IO	io
+
+B::GV
+IoBOTTOM_GV(io)
+	B::IO	io
+
+short
+IoSUBPROCESS(io)
+	B::IO	io
+
+MODULE = B	PACKAGE = B::IO
+
+char
+IoTYPE(io)
+	B::IO	io
+
+U8
+IoFLAGS(io)
+	B::IO	io
+
+MODULE = B	PACKAGE = B::AV		PREFIX = Av
+
+SSize_t
+AvFILL(av)
+	B::AV	av
+
+SSize_t
+AvMAX(av)
+	B::AV	av
+
+#define AvOFF(av) ((XPVAV*)SvANY(av))->xof_off
+
+IV
+AvOFF(av)
+	B::AV	av
+
+void
+AvARRAY(av)
+	B::AV	av
+    PPCODE:
+	if (AvFILL(av) >= 0) {
+	    SV **svp = AvARRAY(av);
+	    I32 i;
+	    for (i = 0; i <= AvFILL(av); i++)
+		XPUSHs(make_sv_object(sv_newmortal(), svp[i]));
+	}
+
+MODULE = B	PACKAGE = B::AV
+
+U8
+AvFLAGS(av)
+	B::AV	av
+
+MODULE = B	PACKAGE = B::CV		PREFIX = Cv
+
+B::HV
+CvSTASH(cv)
+	B::CV	cv
+
+B::OP
+CvSTART(cv)
+	B::CV	cv
+
+B::OP
+CvROOT(cv)
+	B::CV	cv
+
+B::GV
+CvGV(cv)
+	B::CV	cv
+
+B::GV
+CvFILEGV(cv)
+	B::CV	cv
+
+long
+CvDEPTH(cv)
+	B::CV	cv
+
+B::AV
+CvPADLIST(cv)
+	B::CV	cv
+
+B::CV
+CvOUTSIDE(cv)
+	B::CV	cv
+
+void
+CvXSUB(cv)
+	B::CV	cv
+    CODE:
+	ST(0) = sv_2mortal(newSViv((IV)CvXSUB(cv)));
+
+
+void
+CvXSUBANY(cv)
+	B::CV	cv
+    CODE:
+	ST(0) = sv_2mortal(newSViv(CvXSUBANY(cv).any_iv));
+
+MODULE = B	PACKAGE = B::HV		PREFIX = Hv
+
+STRLEN
+HvFILL(hv)
+	B::HV	hv
+
+STRLEN
+HvMAX(hv)
+	B::HV	hv
+
+I32
+HvKEYS(hv)
+	B::HV	hv
+
+I32
+HvRITER(hv)
+	B::HV	hv
+
+char *
+HvNAME(hv)
+	B::HV	hv
+
+B::PMOP
+HvPMROOT(hv)
+	B::HV	hv
+
+void
+HvARRAY(hv)
+	B::HV	hv
+    PPCODE:
+	if (HvKEYS(hv) > 0) {
+	    SV *sv;
+	    char *key;
+	    I32 len;
+	    (void)hv_iterinit(hv);
+	    EXTEND(sp, HvKEYS(hv) * 2);
+	    while (sv = hv_iternextsv(hv, &key, &len)) {
+		PUSHs(newSVpv(key, len));
+		PUSHs(make_sv_object(sv_newmortal(), sv));
+	    }
+	}
diff --git a/contrib/perl5/ext/B/B/Asmdata.pm b/contrib/perl5/ext/B/B/Asmdata.pm
new file mode 100644
index 0000000..f3e57a1
--- /dev/null
+++ b/contrib/perl5/ext/B/B/Asmdata.pm
@@ -0,0 +1,170 @@
+#
+#      Copyright (c) 1996-1998 Malcolm Beattie
+#
+#      You may distribute under the terms of either the GNU General Public
+#      License or the Artistic License, as specified in the README file.
+#
+#
+#
+# This file is autogenerated from bytecode.pl. Changes made here will be lost.
+#
+package B::Asmdata;
+use Exporter;
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(%insn_data @insn_name @optype @specialsv_name);
+use vars qw(%insn_data @insn_name @optype @specialsv_name);
+
+@optype = qw(OP UNOP BINOP LOGOP CONDOP LISTOP PMOP SVOP GVOP PVOP LOOP COP);
+@specialsv_name = qw(Nullsv &PL_sv_undef &PL_sv_yes &PL_sv_no);
+
+# XXX insn_data is initialised this way because with a large
+# %insn_data = (foo => [...], bar => [...], ...) initialiser
+# I get a hard-to-track-down stack underflow and segfault.
+$insn_data{comment} = [35, \&PUT_comment_t, "GET_comment_t"];
+$insn_data{nop} = [10, \&PUT_none, "GET_none"];
+$insn_data{ret} = [0, \&PUT_none, "GET_none"];
+$insn_data{ldsv} = [1, \&PUT_svindex, "GET_svindex"];
+$insn_data{ldop} = [2, \&PUT_opindex, "GET_opindex"];
+$insn_data{stsv} = [3, \&PUT_U32, "GET_U32"];
+$insn_data{stop} = [4, \&PUT_U32, "GET_U32"];
+$insn_data{ldspecsv} = [5, \&PUT_U8, "GET_U8"];
+$insn_data{newsv} = [6, \&PUT_U8, "GET_U8"];
+$insn_data{newop} = [7, \&PUT_U8, "GET_U8"];
+$insn_data{newopn} = [8, \&PUT_U8, "GET_U8"];
+$insn_data{newpv} = [9, \&PUT_PV, "GET_PV"];
+$insn_data{pv_cur} = [11, \&PUT_U32, "GET_U32"];
+$insn_data{pv_free} = [12, \&PUT_none, "GET_none"];
+$insn_data{sv_upgrade} = [13, \&PUT_U8, "GET_U8"];
+$insn_data{sv_refcnt} = [14, \&PUT_U32, "GET_U32"];
+$insn_data{sv_refcnt_add} = [15, \&PUT_I32, "GET_I32"];
+$insn_data{sv_flags} = [16, \&PUT_U32, "GET_U32"];
+$insn_data{xrv} = [17, \&PUT_svindex, "GET_svindex"];
+$insn_data{xpv} = [18, \&PUT_none, "GET_none"];
+$insn_data{xiv32} = [19, \&PUT_I32, "GET_I32"];
+$insn_data{xiv64} = [20, \&PUT_IV64, "GET_IV64"];
+$insn_data{xnv} = [21, \&PUT_double, "GET_double"];
+$insn_data{xlv_targoff} = [22, \&PUT_U32, "GET_U32"];
+$insn_data{xlv_targlen} = [23, \&PUT_U32, "GET_U32"];
+$insn_data{xlv_targ} = [24, \&PUT_svindex, "GET_svindex"];
+$insn_data{xlv_type} = [25, \&PUT_U8, "GET_U8"];
+$insn_data{xbm_useful} = [26, \&PUT_I32, "GET_I32"];
+$insn_data{xbm_previous} = [27, \&PUT_U16, "GET_U16"];
+$insn_data{xbm_rare} = [28, \&PUT_U8, "GET_U8"];
+$insn_data{xfm_lines} = [29, \&PUT_I32, "GET_I32"];
+$insn_data{xio_lines} = [30, \&PUT_I32, "GET_I32"];
+$insn_data{xio_page} = [31, \&PUT_I32, "GET_I32"];
+$insn_data{xio_page_len} = [32, \&PUT_I32, "GET_I32"];
+$insn_data{xio_lines_left} = [33, \&PUT_I32, "GET_I32"];
+$insn_data{xio_top_name} = [34, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{xio_top_gv} = [36, \&PUT_svindex, "GET_svindex"];
+$insn_data{xio_fmt_name} = [37, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{xio_fmt_gv} = [38, \&PUT_svindex, "GET_svindex"];
+$insn_data{xio_bottom_name} = [39, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{xio_bottom_gv} = [40, \&PUT_svindex, "GET_svindex"];
+$insn_data{xio_subprocess} = [41, \&PUT_U16, "GET_U16"];
+$insn_data{xio_type} = [42, \&PUT_U8, "GET_U8"];
+$insn_data{xio_flags} = [43, \&PUT_U8, "GET_U8"];
+$insn_data{xcv_stash} = [44, \&PUT_svindex, "GET_svindex"];
+$insn_data{xcv_start} = [45, \&PUT_opindex, "GET_opindex"];
+$insn_data{xcv_root} = [46, \&PUT_opindex, "GET_opindex"];
+$insn_data{xcv_gv} = [47, \&PUT_svindex, "GET_svindex"];
+$insn_data{xcv_filegv} = [48, \&PUT_svindex, "GET_svindex"];
+$insn_data{xcv_depth} = [49, \&PUT_I32, "GET_I32"];
+$insn_data{xcv_padlist} = [50, \&PUT_svindex, "GET_svindex"];
+$insn_data{xcv_outside} = [51, \&PUT_svindex, "GET_svindex"];
+$insn_data{xcv_flags} = [52, \&PUT_U8, "GET_U8"];
+$insn_data{av_extend} = [53, \&PUT_I32, "GET_I32"];
+$insn_data{av_push} = [54, \&PUT_svindex, "GET_svindex"];
+$insn_data{xav_fill} = [55, \&PUT_I32, "GET_I32"];
+$insn_data{xav_max} = [56, \&PUT_I32, "GET_I32"];
+$insn_data{xav_flags} = [57, \&PUT_U8, "GET_U8"];
+$insn_data{xhv_riter} = [58, \&PUT_I32, "GET_I32"];
+$insn_data{xhv_name} = [59, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{hv_store} = [60, \&PUT_svindex, "GET_svindex"];
+$insn_data{sv_magic} = [61, \&PUT_U8, "GET_U8"];
+$insn_data{mg_obj} = [62, \&PUT_svindex, "GET_svindex"];
+$insn_data{mg_private} = [63, \&PUT_U16, "GET_U16"];
+$insn_data{mg_flags} = [64, \&PUT_U8, "GET_U8"];
+$insn_data{mg_pv} = [65, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{xmg_stash} = [66, \&PUT_svindex, "GET_svindex"];
+$insn_data{gv_fetchpv} = [67, \&PUT_strconst, "GET_strconst"];
+$insn_data{gv_stashpv} = [68, \&PUT_strconst, "GET_strconst"];
+$insn_data{gp_sv} = [69, \&PUT_svindex, "GET_svindex"];
+$insn_data{gp_refcnt} = [70, \&PUT_U32, "GET_U32"];
+$insn_data{gp_refcnt_add} = [71, \&PUT_I32, "GET_I32"];
+$insn_data{gp_av} = [72, \&PUT_svindex, "GET_svindex"];
+$insn_data{gp_hv} = [73, \&PUT_svindex, "GET_svindex"];
+$insn_data{gp_cv} = [74, \&PUT_svindex, "GET_svindex"];
+$insn_data{gp_filegv} = [75, \&PUT_svindex, "GET_svindex"];
+$insn_data{gp_io} = [76, \&PUT_svindex, "GET_svindex"];
+$insn_data{gp_form} = [77, \&PUT_svindex, "GET_svindex"];
+$insn_data{gp_cvgen} = [78, \&PUT_U32, "GET_U32"];
+$insn_data{gp_line} = [79, \&PUT_U16, "GET_U16"];
+$insn_data{gp_share} = [80, \&PUT_svindex, "GET_svindex"];
+$insn_data{xgv_flags} = [81, \&PUT_U8, "GET_U8"];
+$insn_data{op_next} = [82, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_sibling} = [83, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_ppaddr} = [84, \&PUT_strconst, "GET_strconst"];
+$insn_data{op_targ} = [85, \&PUT_U32, "GET_U32"];
+$insn_data{op_type} = [86, \&PUT_U16, "GET_U16"];
+$insn_data{op_seq} = [87, \&PUT_U16, "GET_U16"];
+$insn_data{op_flags} = [88, \&PUT_U8, "GET_U8"];
+$insn_data{op_private} = [89, \&PUT_U8, "GET_U8"];
+$insn_data{op_first} = [90, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_last} = [91, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_other} = [92, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_true} = [93, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_false} = [94, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_children} = [95, \&PUT_U32, "GET_U32"];
+$insn_data{op_pmreplroot} = [96, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_pmreplrootgv} = [97, \&PUT_svindex, "GET_svindex"];
+$insn_data{op_pmreplstart} = [98, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_pmnext} = [99, \&PUT_opindex, "GET_opindex"];
+$insn_data{pregcomp} = [100, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{op_pmflags} = [101, \&PUT_U16, "GET_U16"];
+$insn_data{op_pmpermflags} = [102, \&PUT_U16, "GET_U16"];
+$insn_data{op_sv} = [103, \&PUT_svindex, "GET_svindex"];
+$insn_data{op_gv} = [104, \&PUT_svindex, "GET_svindex"];
+$insn_data{op_pv} = [105, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{op_pv_tr} = [106, \&PUT_op_tr_array, "GET_op_tr_array"];
+$insn_data{op_redoop} = [107, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_nextop} = [108, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_lastop} = [109, \&PUT_opindex, "GET_opindex"];
+$insn_data{cop_label} = [110, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{cop_stash} = [111, \&PUT_svindex, "GET_svindex"];
+$insn_data{cop_filegv} = [112, \&PUT_svindex, "GET_svindex"];
+$insn_data{cop_seq} = [113, \&PUT_U32, "GET_U32"];
+$insn_data{cop_arybase} = [114, \&PUT_I32, "GET_I32"];
+$insn_data{cop_line} = [115, \&PUT_U16, "GET_U16"];
+$insn_data{main_start} = [116, \&PUT_opindex, "GET_opindex"];
+$insn_data{main_root} = [117, \&PUT_opindex, "GET_opindex"];
+$insn_data{curpad} = [118, \&PUT_svindex, "GET_svindex"];
+
+my ($insn_name, $insn_data);
+while (($insn_name, $insn_data) = each %insn_data) {
+    $insn_name[$insn_data->[0]] = $insn_name;
+}
+# Fill in any gaps
+@insn_name = map($_ || "unused", @insn_name);
+
+1;
+
+__END__
+
+=head1 NAME
+
+B::Asmdata - Autogenerated data about Perl ops, used to generate bytecode
+
+=head1 SYNOPSIS
+
+	use Asmdata;
+
+=head1 DESCRIPTION
+
+See F<ext/B/B/Asmdata.pm>.
+
+=head1 AUTHOR
+
+Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
+
+=cut
diff --git a/contrib/perl5/ext/B/B/Assembler.pm b/contrib/perl5/ext/B/B/Assembler.pm
new file mode 100644
index 0000000..defcbdf
--- /dev/null
+++ b/contrib/perl5/ext/B/B/Assembler.pm
@@ -0,0 +1,227 @@
+#      Assembler.pm
+#
+#      Copyright (c) 1996 Malcolm Beattie
+#
+#      You may distribute under the terms of either the GNU General Public
+#      License or the Artistic License, as specified in the README file.
+package B::Assembler;
+use Exporter;
+use B qw(ppname);
+use B::Asmdata qw(%insn_data @insn_name);
+
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(assemble_fh assemble_insn strip_comments
+		parse_statement uncstring);
+
+use strict;
+my %opnumber;
+my ($i, $opname);
+for ($i = 0; defined($opname = ppname($i)); $i++) {
+    $opnumber{$opname} = $i;
+}
+
+my ($linenum, $errors);
+
+sub error {
+    my $str = shift;
+    warn "$linenum: $str\n";
+    $errors++;
+}
+
+my $debug = 0;
+sub debug { $debug = shift }
+
+#
+# First define all the data conversion subs to which Asmdata will refer
+#
+
+sub B::Asmdata::PUT_U8 {
+    my $arg = shift;
+    my $c = uncstring($arg);
+    if (defined($c)) {
+	if (length($c) != 1) {
+	    error "argument for U8 is too long: $c";
+	    $c = substr($c, 0, 1);
+	}
+    } else {
+	$c = chr($arg);
+    }
+    return $c;
+}
+
+sub B::Asmdata::PUT_U16 { pack("n", $_[0]) }
+sub B::Asmdata::PUT_U32 { pack("N", $_[0]) }
+sub B::Asmdata::PUT_I32 { pack("N", $_[0]) }
+sub B::Asmdata::PUT_objindex { pack("N", $_[0]) } # could allow names here
+
+sub B::Asmdata::PUT_strconst {
+    my $arg = shift;
+    $arg = uncstring($arg);
+    if (!defined($arg)) {
+	error "bad string constant: $arg";
+	return "";
+    }
+    if ($arg =~ s/\0//g) {
+	error "string constant argument contains NUL: $arg";
+    }
+    return $arg . "\0";
+}
+
+sub B::Asmdata::PUT_pvcontents {
+    my $arg = shift;
+    error "extraneous argument: $arg" if defined $arg;
+    return "";
+}
+sub B::Asmdata::PUT_PV {
+    my $arg = shift;
+    $arg = uncstring($arg);
+    error "bad string argument: $arg" unless defined($arg);
+    return pack("N", length($arg)) . $arg;
+}
+sub B::Asmdata::PUT_comment {
+    my $arg = shift;
+    $arg = uncstring($arg);
+    error "bad string argument: $arg" unless defined($arg);
+    if ($arg =~ s/\n//g) {
+	error "comment argument contains linefeed: $arg";
+    }
+    return $arg . "\n";
+}
+sub B::Asmdata::PUT_double { sprintf("%s\0", $_[0]) }
+sub B::Asmdata::PUT_none {
+    my $arg = shift;
+    error "extraneous argument: $arg" if defined $arg;
+    return "";
+}
+sub B::Asmdata::PUT_op_tr_array {
+    my $arg = shift;
+    my @ary = split(/\s*,\s*/, $arg);
+    if (@ary != 256) {
+	error "wrong number of arguments to op_tr_array";
+	@ary = (0) x 256;
+    }
+    return pack("n256", @ary);
+}
+# XXX Check this works
+sub B::Asmdata::PUT_IV64 {
+    my $arg = shift;
+    return pack("NN", $arg >> 32, $arg & 0xffffffff);
+}
+
+my %unesc = (n => "\n", r => "\r", t => "\t", a => "\a",
+	     b => "\b", f => "\f", v => "\013");
+
+sub uncstring {
+    my $s = shift;
+    $s =~ s/^"// and $s =~ s/"$// or return undef;
+    $s =~ s/\\(\d\d\d|.)/length($1) == 3 ? chr(oct($1)) : ($unesc{$1}||$1)/eg;
+    return $s;
+}
+
+sub strip_comments {
+    my $stmt = shift;
+    # Comments only allowed in instructions which don't take string arguments
+    $stmt =~ s{
+	(?sx)	# Snazzy extended regexp coming up. Also, treat
+		# string as a single line so .* eats \n characters.
+	^\s*	# Ignore leading whitespace
+	(
+	  [^"]*	# A double quote '"' indicates a string argument. If we
+		# find a double quote, the match fails and we strip nothing.
+	)
+	\s*\#	# Any amount of whitespace plus the comment marker...
+	.*$	# ...which carries on to end-of-string.
+    }{$1};	# Keep only the instruction and optional argument.
+    return $stmt;
+}
+
+sub parse_statement {
+    my $stmt = shift;
+    my ($insn, $arg) = $stmt =~ m{
+	(?sx)
+	^\s*	# allow (but ignore) leading whitespace
+	(.*?)	# Instruction continues up until...
+	(?:	# ...an optional whitespace+argument group
+	    \s+		# first whitespace.
+	    (.*)	# The argument is all the rest (newlines included).
+	)?$	# anchor at end-of-line
+    };	
+    if (defined($arg)) {
+	if ($arg =~ s/^0x(?=[0-9a-fA-F]+$)//) {
+	    $arg = hex($arg);
+	} elsif ($arg =~ s/^0(?=[0-7]+$)//) {
+	    $arg = oct($arg);
+	} elsif ($arg =~ /^pp_/) {
+	    $arg =~ s/\s*$//; # strip trailing whitespace
+	    my $opnum = $opnumber{$arg};
+	    if (defined($opnum)) {
+		$arg = $opnum;
+	    } else {
+		error qq(No such op type "$arg");
+		$arg = 0;
+	    }
+	}
+    }
+    return ($insn, $arg);
+}
+
+sub assemble_insn {
+    my ($insn, $arg) = @_;
+    my $data = $insn_data{$insn};
+    if (defined($data)) {
+	my ($bytecode, $putsub) = @{$data}[0, 1];
+	my $argcode = &$putsub($arg);
+	return chr($bytecode).$argcode;
+    } else {
+	error qq(no such instruction "$insn");
+	return "";
+    }
+}
+
+sub assemble_fh {
+    my ($fh, $out) = @_;
+    my ($line, $insn, $arg);
+    $linenum = 0;
+    $errors = 0;
+    while ($line = <$fh>) {
+	$linenum++;
+	chomp $line;
+	if ($debug) {
+	    my $quotedline = $line;
+	    $quotedline =~ s/\\/\\\\/g;
+	    $quotedline =~ s/"/\\"/g;
+	    &$out(assemble_insn("comment", qq("$quotedline")));
+	}
+	$line = strip_comments($line) or next;
+	($insn, $arg) = parse_statement($line);
+	&$out(assemble_insn($insn, $arg));
+	if ($debug) {
+	    &$out(assemble_insn("nop", undef));
+	}
+    }
+    if ($errors) {
+	die "Assembly failed with $errors error(s)\n";
+    }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+B::Assembler - Assemble Perl bytecode
+
+=head1 SYNOPSIS
+
+	use Assembler;
+
+=head1 DESCRIPTION
+
+See F<ext/B/B/Assembler.pm>.
+
+=head1 AUTHOR
+
+Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
+
+=cut
diff --git a/contrib/perl5/ext/B/B/Bblock.pm b/contrib/perl5/ext/B/B/Bblock.pm
new file mode 100644
index 0000000..a54431b
--- /dev/null
+++ b/contrib/perl5/ext/B/B/Bblock.pm
@@ -0,0 +1,162 @@
+package B::Bblock;
+use Exporter ();
+@ISA = "Exporter";
+@EXPORT_OK = qw(find_leaders);
+
+use B qw(peekop walkoptree walkoptree_exec
+	 main_root main_start svref_2object);
+use B::Terse;
+use strict;
+
+my $bblock;
+my @bblock_ends;
+
+sub mark_leader {
+    my $op = shift;
+    if ($$op) {
+	$bblock->{$$op} = $op;
+    }
+}
+
+sub find_leaders {
+    my ($root, $start) = @_;
+    $bblock = {};
+    mark_leader($start);
+    walkoptree($root, "mark_if_leader");
+    return $bblock;
+}
+
+# Debugging
+sub walk_bblocks {
+    my ($root, $start) = @_;
+    my ($op, $lastop, $leader, $bb);
+    $bblock = {};
+    mark_leader($start);
+    walkoptree($root, "mark_if_leader");
+    my @leaders = values %$bblock;
+    while ($leader = shift @leaders) {
+	$lastop = $leader;
+	$op = $leader->next;
+	while ($$op && !exists($bblock->{$$op})) {
+	    $bblock->{$$op} = $leader;
+	    $lastop = $op;
+	    $op = $op->next;
+	}
+	push(@bblock_ends, [$leader, $lastop]);
+    }
+    foreach $bb (@bblock_ends) {
+	($leader, $lastop) = @$bb;
+	printf "%s .. %s\n", peekop($leader), peekop($lastop);
+	for ($op = $leader; $$op != $$lastop; $op = $op->next) {
+	    printf "    %s\n", peekop($op);
+	}
+	printf "    %s\n", peekop($lastop);
+    }
+    print "-------\n";
+    walkoptree_exec($start, "terse");
+}
+
+sub walk_bblocks_obj {
+    my $cvref = shift;
+    my $cv = svref_2object($cvref);
+    walk_bblocks($cv->ROOT, $cv->START);
+}
+
+sub B::OP::mark_if_leader {}
+
+sub B::COP::mark_if_leader {
+    my $op = shift;
+    if ($op->label) {
+	mark_leader($op);
+    }
+}
+
+sub B::LOOP::mark_if_leader {
+    my $op = shift;
+    mark_leader($op->next);
+    mark_leader($op->nextop);
+    mark_leader($op->redoop);
+    mark_leader($op->lastop->next);
+}
+
+sub B::LOGOP::mark_if_leader {
+    my $op = shift;
+    my $ppaddr = $op->ppaddr;
+    mark_leader($op->next);
+    if ($ppaddr eq "pp_entertry") {
+	mark_leader($op->other->next);
+    } else {
+	mark_leader($op->other);
+    }
+}
+
+sub B::CONDOP::mark_if_leader {
+    my $op = shift;
+    mark_leader($op->next);
+    mark_leader($op->true);
+    mark_leader($op->false);
+}
+
+sub B::PMOP::mark_if_leader {
+    my $op = shift;
+    if ($op->ppaddr ne "pp_pushre") {
+	my $replroot = $op->pmreplroot;
+	if ($$replroot) {
+	    mark_leader($replroot);
+	    mark_leader($op->next);
+	    mark_leader($op->pmreplstart);
+	}
+    }
+}
+
+# PMOP stuff omitted
+
+sub compile {
+    my @options = @_;
+    if (@options) {
+	return sub {
+	    my $objname;
+	    foreach $objname (@options) {
+		$objname = "main::$objname" unless $objname =~ /::/;
+		eval "walk_bblocks_obj(\\&$objname)";
+		die "walk_bblocks_obj(\\&$objname) failed: $@" if $@;
+	    }
+	}
+    } else {
+	return sub { walk_bblocks(main_root, main_start) };
+    }
+}
+
+# Basic block leaders:
+#     Any COP (pp_nextstate) with a non-NULL label
+#     [The op after a pp_enter] Omit
+#     [The op after a pp_entersub. Don't count this one.]
+#     The ops pointed at by nextop, redoop and lastop->op_next of a LOOP
+#     The ops pointed at by op_next and op_other of a LOGOP, except
+#     for pp_entertry which has op_next and op_other->op_next
+#     The ops pointed at by op_true and op_false of a CONDOP
+#     The op pointed at by op_pmreplstart of a PMOP
+#     The op pointed at by op_other->op_pmreplstart of pp_substcont?
+#     [The op after a pp_return] Omit
+
+1;
+
+__END__
+
+=head1 NAME
+
+B::Bblock - Walk basic blocks
+
+=head1 SYNOPSIS
+
+	perl -MO=Bblock[,OPTIONS] foo.pl
+
+=head1 DESCRIPTION
+
+See F<ext/B/README>.
+
+=head1 AUTHOR
+
+Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
+
+=cut
diff --git a/contrib/perl5/ext/B/B/Bytecode.pm b/contrib/perl5/ext/B/B/Bytecode.pm
new file mode 100644
index 0000000..0c5a58d
--- /dev/null
+++ b/contrib/perl5/ext/B/B/Bytecode.pm
@@ -0,0 +1,908 @@
+#      Bytecode.pm
+#
+#      Copyright (c) 1996-1998 Malcolm Beattie
+#
+#      You may distribute under the terms of either the GNU General Public
+#      License or the Artistic License, as specified in the README file.
+#
+package B::Bytecode;
+use strict;
+use Carp;
+use IO::File;
+
+use B qw(minus_c main_cv main_root main_start comppadlist
+	 class peekop walkoptree svref_2object cstring walksymtable);
+use B::Asmdata qw(@optype @specialsv_name);
+use B::Assembler qw(assemble_fh);
+
+my %optype_enum;
+my $i;
+for ($i = 0; $i < @optype; $i++) {
+    $optype_enum{$optype[$i]} = $i;
+}
+
+# Following is SVf_POK|SVp_POK
+# XXX Shouldn't be hardwired
+sub POK () { 0x04040000 }
+
+# Following is SVf_IOK|SVp_OK
+# XXX Shouldn't be hardwired
+sub IOK () { 0x01010000 }
+
+my ($verbose, $module_only, $no_assemble, $debug_bc, $debug_cv);
+my $assembler_pid;
+
+# Optimisation options. On the command line, use hyphens instead of
+# underscores for compatibility with gcc-style options. We use
+# underscores here because they are OK in (strict) barewords.
+my ($strip_syntree, $compress_nullops, $omit_seq, $bypass_nullops);
+my %optimise = (strip_syntax_tree	=> \$strip_syntree,
+		compress_nullops	=> \$compress_nullops,
+		omit_sequence_numbers	=> \$omit_seq,
+		bypass_nullops		=> \$bypass_nullops);
+
+my $nextix = 0;
+my %symtable;	# maps object addresses to object indices.
+		# Filled in at allocation (newsv/newop) time.
+my %saved;	# maps object addresses (for SVish classes) to "saved yet?"
+		# flag. Set at FOO::bytecode time usually by SV::bytecode.
+		# Manipulated via saved(), mark_saved(), unmark_saved().
+
+my $svix = -1;	# we keep track of when the sv register contains an element
+		# of the object table to avoid unnecessary repeated
+		# consecutive ldsv instructions.
+my $opix = -1;	# Ditto for the op register.
+
+sub ldsv {
+    my $ix = shift;
+    if ($ix != $svix) {
+	print "ldsv $ix\n";
+	$svix = $ix;
+    }
+}
+
+sub stsv {
+    my $ix = shift;
+    print "stsv $ix\n";
+    $svix = $ix;
+}
+
+sub set_svix {
+    $svix = shift;
+}
+
+sub ldop {
+    my $ix = shift;
+    if ($ix != $opix) {
+	print "ldop $ix\n";
+	$opix = $ix;
+    }
+}
+
+sub stop {
+    my $ix = shift;
+    print "stop $ix\n";
+    $opix = $ix;
+}
+
+sub set_opix {
+    $opix = shift;
+}
+
+sub pvstring {
+    my $str = shift;
+    if (defined($str)) {
+	return cstring($str . "\0");
+    } else {
+	return '""';
+    }
+}
+
+sub saved { $saved{${$_[0]}} }
+sub mark_saved { $saved{${$_[0]}} = 1 }
+sub unmark_saved { $saved{${$_[0]}} = 0 }
+
+sub debug { $debug_bc = shift }
+
+sub B::OBJECT::nyi {
+    my $obj = shift;
+    warn sprintf("bytecode save method for %s (0x%x) not yet implemented\n",
+		 class($obj), $$obj);
+}
+
+#
+# objix may stomp on the op register (for op objects)
+# or the sv register (for SV objects)
+#
+sub B::OBJECT::objix {
+    my $obj = shift;
+    my $ix = $symtable{$$obj};
+    if (defined($ix)) {
+	return $ix;
+    } else {
+	$obj->newix($nextix);
+	return $symtable{$$obj} = $nextix++;
+    }
+}
+
+sub B::SV::newix {
+    my ($sv, $ix) = @_;
+    printf "newsv %d\t# %s\n", $sv->FLAGS & 0xf, class($sv);
+    stsv($ix);    
+}
+
+sub B::GV::newix {
+    my ($gv, $ix) = @_;
+    my $gvname = $gv->NAME;
+    my $name = cstring($gv->STASH->NAME . "::" . $gvname);
+    print "gv_fetchpv $name\n";
+    stsv($ix);
+}
+
+sub B::HV::newix {
+    my ($hv, $ix) = @_;
+    my $name = $hv->NAME;
+    if ($name) {
+	# It's a stash
+	printf "gv_stashpv %s\n", cstring($name);
+	stsv($ix);
+    } else {
+	# It's an ordinary HV. Fall back to ordinary newix method
+	$hv->B::SV::newix($ix);
+    }
+}
+
+sub B::SPECIAL::newix {
+    my ($sv, $ix) = @_;
+    # Special case. $$sv is not the address of the SV but an
+    # index into svspecialsv_list.
+    printf "ldspecsv $$sv\t# %s\n", $specialsv_name[$$sv];
+    stsv($ix);
+}
+
+sub B::OP::newix {
+    my ($op, $ix) = @_;
+    my $class = class($op);
+    my $typenum = $optype_enum{$class};
+    croak "OP::newix: can't understand class $class" unless defined($typenum);
+    print "newop $typenum\t# $class\n";
+    stop($ix);
+}
+
+sub B::OP::walkoptree_debug {
+    my $op = shift;
+    warn(sprintf("walkoptree: %s\n", peekop($op)));
+}
+
+sub B::OP::bytecode {
+    my $op = shift;
+    my $next = $op->next;
+    my $nextix;
+    my $sibix = $op->sibling->objix;
+    my $ix = $op->objix;
+    my $type = $op->type;
+
+    if ($bypass_nullops) {
+	$next = $next->next while $$next && $next->type == 0;
+    }
+    $nextix = $next->objix;
+
+    printf "# %s\n", peekop($op) if $debug_bc;
+    ldop($ix);
+    print "op_next $nextix\n";
+    print "op_sibling $sibix\n" unless $strip_syntree;
+    printf "op_type %s\t# %d\n", $op->ppaddr, $type;
+    printf("op_seq %d\n", $op->seq) unless $omit_seq;
+    if ($type || !$compress_nullops) {
+	printf "op_targ %d\nop_flags 0x%x\nop_private 0x%x\n",
+	    $op->targ, $op->flags, $op->private;
+    }
+}
+
+sub B::UNOP::bytecode {
+    my $op = shift;
+    my $firstix = $op->first->objix;
+    $op->B::OP::bytecode;
+    if (($op->type || !$compress_nullops) && !$strip_syntree) {
+	print "op_first $firstix\n";
+    }
+}
+
+sub B::LOGOP::bytecode {
+    my $op = shift;
+    my $otherix = $op->other->objix;
+    $op->B::UNOP::bytecode;
+    print "op_other $otherix\n";
+}
+
+sub B::SVOP::bytecode {
+    my $op = shift;
+    my $sv = $op->sv;
+    my $svix = $sv->objix;
+    $op->B::OP::bytecode;
+    print "op_sv $svix\n";
+    $sv->bytecode;
+}
+
+sub B::GVOP::bytecode {
+    my $op = shift;
+    my $gv = $op->gv;
+    my $gvix = $gv->objix;
+    $op->B::OP::bytecode;
+    print "op_gv $gvix\n";
+    $gv->bytecode;
+}
+
+sub B::PVOP::bytecode {
+    my $op = shift;
+    my $pv = $op->pv;
+    $op->B::OP::bytecode;
+    #
+    # This would be easy except that OP_TRANS uses a PVOP to store an
+    # endian-dependent array of 256 shorts instead of a plain string.
+    #
+    if ($op->ppaddr eq "pp_trans") {
+	my @shorts = unpack("s256", $pv); # assembler handles endianness
+	print "op_pv_tr ", join(",", @shorts), "\n";
+    } else {
+	printf "newpv %s\nop_pv\n", pvstring($pv);
+    }
+}
+
+sub B::BINOP::bytecode {
+    my $op = shift;
+    my $lastix = $op->last->objix;
+    $op->B::UNOP::bytecode;
+    if (($op->type || !$compress_nullops) && !$strip_syntree) {
+	print "op_last $lastix\n";
+    }
+}
+
+sub B::CONDOP::bytecode {
+    my $op = shift;
+    my $trueix = $op->true->objix;
+    my $falseix = $op->false->objix;
+    $op->B::UNOP::bytecode;
+    print "op_true $trueix\nop_false $falseix\n";
+}
+
+sub B::LISTOP::bytecode {
+    my $op = shift;
+    my $children = $op->children;
+    $op->B::BINOP::bytecode;
+    if (($op->type || !$compress_nullops) && !$strip_syntree) {
+	print "op_children $children\n";
+    }
+}
+
+sub B::LOOP::bytecode {
+    my $op = shift;
+    my $redoopix = $op->redoop->objix;
+    my $nextopix = $op->nextop->objix;
+    my $lastopix = $op->lastop->objix;
+    $op->B::LISTOP::bytecode;
+    print "op_redoop $redoopix\nop_nextop $nextopix\nop_lastop $lastopix\n";
+}
+
+sub B::COP::bytecode {
+    my $op = shift;
+    my $stash = $op->stash;
+    my $stashix = $stash->objix;
+    my $filegv = $op->filegv;
+    my $filegvix = $filegv->objix;
+    my $line = $op->line;
+    if ($debug_bc) {
+	printf "# line %s:%d\n", $filegv->SV->PV, $line;
+    }
+    $op->B::OP::bytecode;
+    printf <<"EOT", pvstring($op->label), $op->cop_seq, $op->arybase;
+newpv %s
+cop_label
+cop_stash $stashix
+cop_seq %d
+cop_filegv $filegvix
+cop_arybase %d
+cop_line $line
+EOT
+    $filegv->bytecode;
+    $stash->bytecode;
+}
+
+sub B::PMOP::bytecode {
+    my $op = shift;
+    my $replroot = $op->pmreplroot;
+    my $replrootix = $replroot->objix;
+    my $replstartix = $op->pmreplstart->objix;
+    my $ppaddr = $op->ppaddr;
+    # pmnext is corrupt in some PMOPs (see misc.t for example)
+    #my $pmnextix = $op->pmnext->objix;
+
+    if ($$replroot) {
+	# OP_PUSHRE (a mutated version of OP_MATCH for the regexp
+	# argument to a split) stores a GV in op_pmreplroot instead
+	# of a substitution syntax tree. We don't want to walk that...
+	if ($ppaddr eq "pp_pushre") {
+	    $replroot->bytecode;
+	} else {
+	    walkoptree($replroot, "bytecode");
+	}
+    }
+    $op->B::LISTOP::bytecode;
+    if ($ppaddr eq "pp_pushre") {
+	printf "op_pmreplrootgv $replrootix\n";
+    } else {
+	print "op_pmreplroot $replrootix\nop_pmreplstart $replstartix\n";
+    }
+    my $re = pvstring($op->precomp);
+    # op_pmnext omitted since a perl bug means it's sometime corrupt
+    printf <<"EOT", $op->pmflags, $op->pmpermflags;
+op_pmflags 0x%x
+op_pmpermflags 0x%x
+newpv $re
+pregcomp
+EOT
+}
+
+sub B::SV::bytecode {
+    my $sv = shift;
+    return if saved($sv);
+    my $ix = $sv->objix;
+    my $refcnt = $sv->REFCNT;
+    my $flags = sprintf("0x%x", $sv->FLAGS);
+    ldsv($ix);
+    print "sv_refcnt $refcnt\nsv_flags $flags\n";
+    mark_saved($sv);
+}
+
+sub B::PV::bytecode {
+    my $sv = shift;
+    return if saved($sv);
+    $sv->B::SV::bytecode;
+    printf("newpv %s\nxpv\n", pvstring($sv->PV)) if $sv->FLAGS & POK;
+}
+
+sub B::IV::bytecode {
+    my $sv = shift;
+    return if saved($sv);
+    my $iv = $sv->IVX;
+    $sv->B::SV::bytecode;
+    printf "%s $iv\n", $sv->needs64bits ? "xiv64" : "xiv32";
+}
+
+sub B::NV::bytecode {
+    my $sv = shift;
+    return if saved($sv);
+    $sv->B::SV::bytecode;
+    printf "xnv %s\n", $sv->NVX;
+}
+
+sub B::RV::bytecode {
+    my $sv = shift;
+    return if saved($sv);
+    my $rv = $sv->RV;
+    my $rvix = $rv->objix;
+    $rv->bytecode;
+    $sv->B::SV::bytecode;
+    print "xrv $rvix\n";
+}
+
+sub B::PVIV::bytecode {
+    my $sv = shift;
+    return if saved($sv);
+    my $iv = $sv->IVX;
+    $sv->B::PV::bytecode;
+    printf "%s $iv\n", $sv->needs64bits ? "xiv64" : "xiv32";
+}
+
+sub B::PVNV::bytecode {
+    my ($sv, $flag) = @_;
+    # The $flag argument is passed through PVMG::bytecode by BM::bytecode
+    # and AV::bytecode and indicates special handling. $flag = 1 is used by
+    # BM::bytecode and means that we should ensure we save the whole B-M
+    # table. It consists of 257 bytes (256 char array plus a final \0)
+    # which follow the ordinary PV+\0 and the 257 bytes are *not* reflected
+    # in SvCUR. $flag = 2 is used by AV::bytecode and means that we only
+    # call SV::bytecode instead of saving PV and calling NV::bytecode since
+    # PV/NV/IV stuff is different for AVs.
+    return if saved($sv);
+    if ($flag == 2) {
+	$sv->B::SV::bytecode;
+    } else {
+	my $pv = $sv->PV;
+	$sv->B::IV::bytecode;
+	printf "xnv %s\n", $sv->NVX;
+	if ($flag == 1) {
+	    $pv .= "\0" . $sv->TABLE;
+	    printf "newpv %s\npv_cur %d\nxpv\n", pvstring($pv),length($pv)-257;
+	} else {
+	    printf("newpv %s\nxpv\n", pvstring($pv)) if $sv->FLAGS & POK;
+	}
+    }
+}
+
+sub B::PVMG::bytecode {
+    my ($sv, $flag) = @_;
+    # See B::PVNV::bytecode for an explanation of $flag.
+    return if saved($sv);
+    # XXX We assume SvSTASH is already saved and don't save it later ourselves
+    my $stashix = $sv->SvSTASH->objix;
+    my @mgchain = $sv->MAGIC;
+    my (@mgobjix, $mg);
+    #
+    # We need to traverse the magic chain and get objix for each OBJ
+    # field *before* we do B::PVNV::bytecode since objix overwrites
+    # the sv register. However, we need to write the magic-saving
+    # bytecode *after* B::PVNV::bytecode since sv isn't initialised
+    # to refer to $sv until then.
+    #
+    @mgobjix = map($_->OBJ->objix, @mgchain);
+    $sv->B::PVNV::bytecode($flag);
+    print "xmg_stash $stashix\n";
+    foreach $mg (@mgchain) {
+	printf "sv_magic %s\nmg_obj %d\nnewpv %s\nmg_pv\n",
+	    cstring($mg->TYPE), shift(@mgobjix), pvstring($mg->PTR);
+    }
+}
+
+sub B::PVLV::bytecode {
+    my $sv = shift;
+    return if saved($sv);
+    $sv->B::PVMG::bytecode;
+    printf <<'EOT', $sv->TARGOFF, $sv->TARGLEN, cstring($sv->TYPE);
+xlv_targoff %d
+xlv_targlen %d
+xlv_type %s
+EOT
+}
+
+sub B::BM::bytecode {
+    my $sv = shift;
+    return if saved($sv);
+    # See PVNV::bytecode for an explanation of what the argument does
+    $sv->B::PVMG::bytecode(1);
+    printf "xbm_useful %d\nxbm_previous %d\nxbm_rare %d\n",
+	$sv->USEFUL, $sv->PREVIOUS, $sv->RARE;
+}
+
+sub B::GV::bytecode {
+    my $gv = shift;
+    return if saved($gv);
+    my $ix = $gv->objix;
+    mark_saved($gv);
+    my $gvname = $gv->NAME;
+    my $name = cstring($gv->STASH->NAME . "::" . $gvname);
+    my $egv = $gv->EGV;
+    my $egvix = $egv->objix;
+    ldsv($ix);
+    printf <<"EOT", $gv->FLAGS, $gv->GvFLAGS, $gv->LINE;
+sv_flags 0x%x
+xgv_flags 0x%x
+gp_line %d
+EOT
+    my $refcnt = $gv->REFCNT;
+    printf("sv_refcnt_add %d\n", $refcnt - 1) if $refcnt > 1;
+    my $gvrefcnt = $gv->GvREFCNT;
+    printf("gp_refcnt_add %d\n", $gvrefcnt - 1) if $gvrefcnt > 1;
+    if ($gvrefcnt > 1 &&  $ix != $egvix) {
+	print "gp_share $egvix\n";
+    } else {
+	if ($gvname !~ /^([^A-Za-z]|STDIN|STDOUT|STDERR|ARGV|SIG|ENV)$/) {
+	    my $i;
+	    my @subfield_names = qw(SV AV HV CV FILEGV FORM IO);
+	    my @subfields = map($gv->$_(), @subfield_names);
+	    my @ixes = map($_->objix, @subfields);
+	    # Reset sv register for $gv
+	    ldsv($ix);
+	    for ($i = 0; $i < @ixes; $i++) {
+		printf "gp_%s %d\n", lc($subfield_names[$i]), $ixes[$i];
+	    }
+	    # Now save all the subfields
+	    my $sv;
+	    foreach $sv (@subfields) {
+		$sv->bytecode;
+	    }
+	}
+    }
+}
+
+sub B::HV::bytecode {
+    my $hv = shift;
+    return if saved($hv);
+    mark_saved($hv);
+    my $name = $hv->NAME;
+    my $ix = $hv->objix;
+    if (!$name) {
+	# It's an ordinary HV. Stashes have NAME set and need no further
+	# saving beyond the gv_stashpv that $hv->objix already ensures.
+	my @contents = $hv->ARRAY;
+	my ($i, @ixes);
+	for ($i = 1; $i < @contents; $i += 2) {
+	    push(@ixes, $contents[$i]->objix);
+	}
+	for ($i = 1; $i < @contents; $i += 2) {
+	    $contents[$i]->bytecode;
+	}
+	ldsv($ix);
+	for ($i = 0; $i < @contents; $i += 2) {
+	    printf("newpv %s\nhv_store %d\n",
+		   pvstring($contents[$i]), $ixes[$i / 2]);
+	}
+	printf "sv_refcnt %d\nsv_flags 0x%x\n", $hv->REFCNT, $hv->FLAGS;
+    }
+}
+
+sub B::AV::bytecode {
+    my $av = shift;
+    return if saved($av);
+    my $ix = $av->objix;
+    my $fill = $av->FILL;
+    my $max = $av->MAX;
+    my (@array, @ixes);
+    if ($fill > -1) {
+	@array = $av->ARRAY;
+	@ixes = map($_->objix, @array);
+	my $sv;
+	foreach $sv (@array) {
+	    $sv->bytecode;
+	}
+    }
+    # See PVNV::bytecode for the meaning of the flag argument of 2.
+    $av->B::PVMG::bytecode(2);
+    # Recover sv register and set AvMAX and AvFILL to -1 (since we
+    # create an AV with NEWSV and SvUPGRADE rather than doing newAV
+    # which is what sets AvMAX and AvFILL.
+    ldsv($ix);
+    printf "xav_flags 0x%x\nxav_max -1\nxav_fill -1\n", $av->AvFLAGS;
+    if ($fill > -1) {
+	my $elix;
+	foreach $elix (@ixes) {
+	    print "av_push $elix\n";
+	}
+    } else {
+	if ($max > -1) {
+	    print "av_extend $max\n";
+	}
+    }
+}
+
+sub B::CV::bytecode {
+    my $cv = shift;
+    return if saved($cv);
+    my $ix = $cv->objix;
+    $cv->B::PVMG::bytecode;
+    my $i;
+    my @subfield_names = qw(ROOT START STASH GV FILEGV PADLIST OUTSIDE);
+    my @subfields = map($cv->$_(), @subfield_names);
+    my @ixes = map($_->objix, @subfields);
+    # Save OP tree from CvROOT (first element of @subfields)
+    my $root = shift @subfields;
+    if ($$root) {
+	walkoptree($root, "bytecode");
+    }
+    # Reset sv register for $cv (since above ->objix calls stomped on it)
+    ldsv($ix);
+    for ($i = 0; $i < @ixes; $i++) {
+	printf "xcv_%s %d\n", lc($subfield_names[$i]), $ixes[$i];
+    }
+    printf "xcv_depth %d\nxcv_flags 0x%x\n", $cv->DEPTH, $cv->FLAGS;
+    # Now save all the subfields (except for CvROOT which was handled
+    # above) and CvSTART (now the initial element of @subfields).
+    shift @subfields; # bye-bye CvSTART
+    my $sv;
+    foreach $sv (@subfields) {
+	$sv->bytecode;
+    }
+}
+
+sub B::IO::bytecode {
+    my $io = shift;
+    return if saved($io);
+    my $ix = $io->objix;
+    my $top_gv = $io->TOP_GV;
+    my $top_gvix = $top_gv->objix;
+    my $fmt_gv = $io->FMT_GV;
+    my $fmt_gvix = $fmt_gv->objix;
+    my $bottom_gv = $io->BOTTOM_GV;
+    my $bottom_gvix = $bottom_gv->objix;
+
+    $io->B::PVMG::bytecode;
+    ldsv($ix);
+    print "xio_top_gv $top_gvix\n";
+    print "xio_fmt_gv $fmt_gvix\n";
+    print "xio_bottom_gv $bottom_gvix\n";
+    my $field;
+    foreach $field (qw(TOP_NAME FMT_NAME BOTTOM_NAME)) {
+	printf "newpv %s\nxio_%s\n", pvstring($io->$field()), lc($field);
+    }
+    foreach $field (qw(LINES PAGE PAGE_LEN LINES_LEFT SUBPROCESS)) {
+	printf "xio_%s %d\n", lc($field), $io->$field();
+    }
+    printf "xio_type %s\nxio_flags 0x%x\n", cstring($io->IoTYPE), $io->IoFLAGS;
+    $top_gv->bytecode;
+    $fmt_gv->bytecode;
+    $bottom_gv->bytecode;
+}
+
+sub B::SPECIAL::bytecode {
+    # nothing extra needs doing
+}
+
+sub bytecompile_object {
+    my $sv;
+    foreach $sv (@_) {
+	svref_2object($sv)->bytecode;
+    }
+}
+
+sub B::GV::bytecodecv {
+    my $gv = shift;
+    my $cv = $gv->CV;
+    if ($$cv && !saved($cv)) {
+	if ($debug_cv) {
+	    warn sprintf("saving extra CV &%s::%s (0x%x) from GV 0x%x\n",
+			 $gv->STASH->NAME, $gv->NAME, $$cv, $$gv);
+	}
+	$gv->bytecode;
+    }
+}
+
+sub bytecompile_main {
+    my $curpad = (comppadlist->ARRAY)[1];
+    my $curpadix = $curpad->objix;
+    $curpad->bytecode;
+    walkoptree(main_root, "bytecode");
+    warn "done main program, now walking symbol table\n" if $debug_bc;
+    my ($pack, %exclude);
+    foreach $pack (qw(B O AutoLoader DynaLoader Config DB VMS strict vars
+		      FileHandle Exporter Carp UNIVERSAL IO Fcntl Symbol
+		      SelectSaver blib Cwd))
+    {
+	$exclude{$pack."::"} = 1;
+    }
+    no strict qw(vars refs);
+    walksymtable(\%{"main::"}, "bytecodecv", sub {
+	warn "considering $_[0]\n" if $debug_bc;
+	return !defined($exclude{$_[0]});
+    });
+    if (!$module_only) {
+	printf "main_root %d\n", main_root->objix;
+	printf "main_start %d\n", main_start->objix;
+	printf "curpad $curpadix\n";
+	# XXX Do min_intro_pending and max_intro_pending matter?
+    }
+}
+
+sub prepare_assemble {
+    my $newfh = IO::File->new_tmpfile;
+    select($newfh);
+    binmode $newfh;
+    return $newfh;
+}
+
+sub do_assemble {
+    my $fh = shift;
+    seek($fh, 0, 0); # rewind the temporary file
+    assemble_fh($fh, sub { print OUT @_ });
+}
+
+sub compile {
+    my @options = @_;
+    my ($option, $opt, $arg);
+    open(OUT, ">&STDOUT");
+    binmode OUT;
+    select(OUT);
+  OPTION:
+    while ($option = shift @options) {
+	if ($option =~ /^-(.)(.*)/) {
+	    $opt = $1;
+	    $arg = $2;
+	} else {
+	    unshift @options, $option;
+	    last OPTION;
+	}
+	if ($opt eq "-" && $arg eq "-") {
+	    shift @options;
+	    last OPTION;
+	} elsif ($opt eq "o") {
+	    $arg ||= shift @options;
+	    open(OUT, ">$arg") or return "$arg: $!\n";
+	    binmode OUT;
+	} elsif ($opt eq "D") {
+	    $arg ||= shift @options;
+	    foreach $arg (split(//, $arg)) {
+		if ($arg eq "b") {
+		    $| = 1;
+		    debug(1);
+		} elsif ($arg eq "o") {
+		    B->debug(1);
+		} elsif ($arg eq "a") {
+		    B::Assembler::debug(1);
+		} elsif ($arg eq "C") {
+		    $debug_cv = 1;
+		}
+	    }
+	} elsif ($opt eq "v") {
+	    $verbose = 1;
+	} elsif ($opt eq "m") {
+	    $module_only = 1;
+	} elsif ($opt eq "S") {
+	    $no_assemble = 1;
+	} elsif ($opt eq "f") {
+	    $arg ||= shift @options;
+	    my $value = $arg !~ s/^no-//;
+	    $arg =~ s/-/_/g;
+	    my $ref = $optimise{$arg};
+	    if (defined($ref)) {
+		$$ref = $value;
+	    } else {
+		warn qq(ignoring unknown optimisation option "$arg"\n);
+	    }
+	} elsif ($opt eq "O") {
+	    $arg = 1 if $arg eq "";
+	    my $ref;
+	    foreach $ref (values %optimise) {
+		$$ref = 0;
+	    }
+	    if ($arg >= 6) {
+		$strip_syntree = 1;
+	    }
+	    if ($arg >= 2) {
+		$bypass_nullops = 1;
+	    }
+	    if ($arg >= 1) {
+		$compress_nullops = 1;
+		$omit_seq = 1;
+	    }
+	}
+    }
+    if (@options) {
+	return sub {
+	    my $objname;
+	    my $newfh; 
+	    $newfh = prepare_assemble() unless $no_assemble;
+	    foreach $objname (@options) {
+		eval "bytecompile_object(\\$objname)";
+	    }
+	    do_assemble($newfh) unless $no_assemble;
+	}
+    } else {
+	return sub {
+	    my $newfh; 
+	    $newfh = prepare_assemble() unless $no_assemble;
+	    bytecompile_main();
+	    do_assemble($newfh) unless $no_assemble;
+	}
+    }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+B::Bytecode - Perl compiler's bytecode backend
+
+=head1 SYNOPSIS
+
+	perl -MO=Bytecode[,OPTIONS] foo.pl
+
+=head1 DESCRIPTION
+
+This compiler backend takes Perl source and generates a
+platform-independent bytecode encapsulating code to load the
+internal structures perl uses to run your program. When the
+generated bytecode is loaded in, your program is ready to run,
+reducing the time which perl would have taken to load and parse
+your program into its internal semi-compiled form. That means that
+compiling with this backend will not help improve the runtime
+execution speed of your program but may improve the start-up time.
+Depending on the environment in which your program runs this may
+or may not be a help.
+
+The resulting bytecode can be run with a special byteperl executable
+or (for non-main programs) be loaded via the C<byteload_fh> function
+in the F<B> module.
+
+=head1 OPTIONS
+
+If there are any non-option arguments, they are taken to be names of
+objects to be saved (probably doesn't work properly yet).  Without
+extra arguments, it saves the main program.
+
+=over 4
+
+=item B<-ofilename>
+
+Output to filename instead of STDOUT.
+
+=item B<-->
+
+Force end of options.
+
+=item B<-f>
+
+Force optimisations on or off one at a time. Each can be preceded
+by B<no-> to turn the option off (e.g. B<-fno-compress-nullops>).
+
+=item B<-fcompress-nullops>
+
+Only fills in the necessary fields of ops which have
+been optimised away by perl's internal compiler.
+
+=item B<-fomit-sequence-numbers>
+
+Leaves out code to fill in the op_seq field of all ops
+which is only used by perl's internal compiler.
+
+=item B<-fbypass-nullops>
+
+If op->op_next ever points to a NULLOP, replaces the op_next field
+with the first non-NULLOP in the path of execution.
+
+=item B<-fstrip-syntax-tree>
+
+Leaves out code to fill in the pointers which link the internal syntax
+tree together. They're not needed at run-time but leaving them out
+will make it impossible to recompile or disassemble the resulting
+program.  It will also stop C<goto label> statements from working.
+
+=item B<-On>
+
+Optimisation level (n = 0, 1, 2, ...). B<-O> means B<-O1>.
+B<-O1> sets B<-fcompress-nullops> B<-fomit-sequence numbers>.
+B<-O6> adds B<-fstrip-syntax-tree>.
+
+=item B<-D>
+
+Debug options (concatenated or separate flags like C<perl -D>).
+
+=item B<-Do>
+
+Prints each OP as it's processed.
+
+=item B<-Db>
+
+Print debugging information about bytecompiler progress.
+
+=item B<-Da>
+
+Tells the (bytecode) assembler to include source assembler lines
+in its output as bytecode comments.
+
+=item B<-DC>
+
+Prints each CV taken from the final symbol tree walk.
+
+=item B<-S>
+
+Output (bytecode) assembler source rather than piping it
+through the assembler and outputting bytecode.
+
+=item B<-m>
+
+Compile as a module rather than a standalone program. Currently this
+just means that the bytecodes for initialising C<main_start>,
+C<main_root> and C<curpad> are omitted.
+
+=back
+
+=head1 EXAMPLES
+
+        perl -MO=Bytecode,-O6,-o,foo.plc foo.pl
+
+        perl -MO=Bytecode,-S foo.pl > foo.S
+        assemble foo.S > foo.plc
+        byteperl foo.plc
+
+        perl -MO=Bytecode,-m,-oFoo.pmc Foo.pm
+
+=head1 BUGS
+
+Plenty. Current status: experimental.
+
+=head1 AUTHOR
+
+Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
+
+=cut
diff --git a/contrib/perl5/ext/B/B/C.pm b/contrib/perl5/ext/B/B/C.pm
new file mode 100644
index 0000000..0b7d6eb
--- /dev/null
+++ b/contrib/perl5/ext/B/B/C.pm
@@ -0,0 +1,1319 @@
+#      C.pm
+#
+#      Copyright (c) 1996, 1997, 1998 Malcolm Beattie
+#
+#      You may distribute under the terms of either the GNU General Public
+#      License or the Artistic License, as specified in the README file.
+#
+package B::C;
+use Exporter ();
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(output_all output_boilerplate output_main
+		init_sections set_callback save_unused_subs objsym);
+
+use B qw(minus_c sv_undef walkoptree walksymtable main_root main_start peekop
+	 class cstring cchar svref_2object compile_stats comppadlist hash
+	 threadsv_names);
+use B::Asmdata qw(@specialsv_name);
+
+use FileHandle;
+use Carp;
+use strict;
+
+my $hv_index = 0;
+my $gv_index = 0;
+my $re_index = 0;
+my $pv_index = 0;
+my $anonsub_index = 0;
+
+my %symtable;
+my $warn_undefined_syms;
+my $verbose;
+my @unused_sub_packages;
+my $nullop_count;
+my $pv_copy_on_grow;
+my ($debug_cops, $debug_av, $debug_cv, $debug_mg);
+
+my @threadsv_names;
+BEGIN {
+    @threadsv_names = threadsv_names();
+}
+
+# Code sections
+my ($init, $decl, $symsect, $binopsect, $condopsect, $copsect, $cvopsect,
+    $gvopsect, $listopsect, $logopsect, $loopsect, $opsect, $pmopsect,
+    $pvopsect, $svopsect, $unopsect, $svsect, $xpvsect, $xpvavsect,
+    $xpvhvsect, $xpvcvsect, $xpvivsect, $xpvnvsect, $xpvmgsect, $xpvlvsect,
+    $xrvsect, $xpvbmsect, $xpviosect);
+
+sub walk_and_save_optree;
+my $saveoptree_callback = \&walk_and_save_optree;
+sub set_callback { $saveoptree_callback = shift }
+sub saveoptree { &$saveoptree_callback(@_) }
+
+sub walk_and_save_optree {
+    my ($name, $root, $start) = @_;
+    walkoptree($root, "save");
+    return objsym($start);
+}
+
+# Current workaround/fix for op_free() trying to free statically
+# defined OPs is to set op_seq = -1 and check for that in op_free().
+# Instead of hardwiring -1 in place of $op->seq, we use $op_seq
+# so that it can be changed back easily if necessary. In fact, to
+# stop compilers from moaning about a U16 being initialised with an
+# uncast -1 (the printf format is %d so we can't tweak it), we have
+# to "know" that op_seq is a U16 and use 65535. Ugh.
+my $op_seq = 65535;
+
+sub AVf_REAL () { 1 }
+
+# XXX This shouldn't really be hardcoded here but it saves
+# looking up the name of every BASEOP in B::OP
+sub OP_THREADSV () { 345 }
+
+sub savesym {
+    my ($obj, $value) = @_;
+    my $sym = sprintf("s\\_%x", $$obj);
+    $symtable{$sym} = $value;
+}
+
+sub objsym {
+    my $obj = shift;
+    return $symtable{sprintf("s\\_%x", $$obj)};
+}
+
+sub getsym {
+    my $sym = shift;
+    my $value;
+
+    return 0 if $sym eq "sym_0";	# special case
+    $value = $symtable{$sym};
+    if (defined($value)) {
+	return $value;
+    } else {
+	warn "warning: undefined symbol $sym\n" if $warn_undefined_syms;
+	return "UNUSED";
+    }
+}
+
+sub savepv {
+    my $pv = shift;
+    my $pvsym = 0;
+    my $pvmax = 0;
+    if ($pv_copy_on_grow) {
+	my $cstring = cstring($pv);
+	if ($cstring ne "0") { # sic
+	    $pvsym = sprintf("pv%d", $pv_index++);
+	    $decl->add(sprintf("static char %s[] = %s;", $pvsym, $cstring));
+	}
+    } else {
+	$pvmax = length($pv) + 1;
+    }
+    return ($pvsym, $pvmax);
+}
+
+sub B::OP::save {
+    my ($op, $level) = @_;
+    my $type = $op->type;
+    $nullop_count++ unless $type;
+    if ($type == OP_THREADSV) {
+	# saves looking up ppaddr but it's a bit naughty to hard code this
+	$init->add(sprintf("(void)find_threadsv(%s);",
+			   cstring($threadsv_names[$op->targ])));
+    }
+    $opsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x",
+			 ${$op->next}, ${$op->sibling}, $op->ppaddr, $op->targ,
+			 $type, $op_seq, $op->flags, $op->private));
+    savesym($op, sprintf("&op_list[%d]", $opsect->index));
+}
+
+sub B::FAKEOP::new {
+    my ($class, %objdata) = @_;
+    bless \%objdata, $class;
+}
+
+sub B::FAKEOP::save {
+    my ($op, $level) = @_;
+    $opsect->add(sprintf("%s, %s, %s, %u, %u, %u, 0x%x, 0x%x",
+			 $op->next, $op->sibling, $op->ppaddr, $op->targ,
+			 $op->type, $op_seq, $op->flags, $op->private));
+    return sprintf("&op_list[%d]", $opsect->index);
+}
+
+sub B::FAKEOP::next { $_[0]->{"next"} || 0 }
+sub B::FAKEOP::type { $_[0]->{type} || 0}
+sub B::FAKEOP::sibling { $_[0]->{sibling} || 0 }
+sub B::FAKEOP::ppaddr { $_[0]->{ppaddr} || 0 }
+sub B::FAKEOP::targ { $_[0]->{targ} || 0 }
+sub B::FAKEOP::flags { $_[0]->{flags} || 0 }
+sub B::FAKEOP::private { $_[0]->{private} || 0 }
+
+sub B::UNOP::save {
+    my ($op, $level) = @_;
+    $unopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, s\\_%x",
+			   ${$op->next}, ${$op->sibling}, $op->ppaddr,
+			   $op->targ, $op->type, $op_seq, $op->flags,
+			   $op->private, ${$op->first}));
+    savesym($op, sprintf("(OP*)&unop_list[%d]", $unopsect->index));
+}
+
+sub B::BINOP::save {
+    my ($op, $level) = @_;
+    $binopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x",
+			    ${$op->next}, ${$op->sibling}, $op->ppaddr,
+			    $op->targ, $op->type, $op_seq, $op->flags,
+			    $op->private, ${$op->first}, ${$op->last}));
+    savesym($op, sprintf("(OP*)&binop_list[%d]", $binopsect->index));
+}
+
+sub B::LISTOP::save {
+    my ($op, $level) = @_;
+    $listopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x, %u",
+			     ${$op->next}, ${$op->sibling}, $op->ppaddr,
+			     $op->targ, $op->type, $op_seq, $op->flags,
+			     $op->private, ${$op->first}, ${$op->last},
+			     $op->children));
+    savesym($op, sprintf("(OP*)&listop_list[%d]", $listopsect->index));
+}
+
+sub B::LOGOP::save {
+    my ($op, $level) = @_;
+    $logopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x",
+			    ${$op->next}, ${$op->sibling}, $op->ppaddr,
+			    $op->targ, $op->type, $op_seq, $op->flags,
+			    $op->private, ${$op->first}, ${$op->other}));
+    savesym($op, sprintf("(OP*)&logop_list[%d]", $logopsect->index));
+}
+
+sub B::CONDOP::save {
+    my ($op, $level) = @_;
+    $condopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x, s\\_%x",
+			     ${$op->next}, ${$op->sibling}, $op->ppaddr,
+			     $op->targ, $op->type, $op_seq, $op->flags,
+			     $op->private, ${$op->first}, ${$op->true},
+			     ${$op->false}));
+    savesym($op, sprintf("(OP*)&condop_list[%d]", $condopsect->index));
+}
+
+sub B::LOOP::save {
+    my ($op, $level) = @_;
+    #warn sprintf("LOOP: redoop %s, nextop %s, lastop %s\n",
+    #		 peekop($op->redoop), peekop($op->nextop),
+    #		 peekop($op->lastop)); # debug
+    $loopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x, %u, s\\_%x, s\\_%x, s\\_%x",
+			   ${$op->next}, ${$op->sibling}, $op->ppaddr,
+			   $op->targ, $op->type, $op_seq, $op->flags,
+			   $op->private, ${$op->first}, ${$op->last},
+			   $op->children, ${$op->redoop}, ${$op->nextop},
+			   ${$op->lastop}));
+    savesym($op, sprintf("(OP*)&loop_list[%d]", $loopsect->index));
+}
+
+sub B::PVOP::save {
+    my ($op, $level) = @_;
+    $pvopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, %s",
+			   ${$op->next}, ${$op->sibling}, $op->ppaddr,
+			   $op->targ, $op->type, $op_seq, $op->flags,
+			   $op->private, cstring($op->pv)));
+    savesym($op, sprintf("(OP*)&pvop_list[%d]", $pvopsect->index));
+}
+
+sub B::SVOP::save {
+    my ($op, $level) = @_;
+    my $svsym = $op->sv->save;
+    $svopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, %s",
+			   ${$op->next}, ${$op->sibling}, $op->ppaddr,
+			   $op->targ, $op->type, $op_seq, $op->flags,
+			   $op->private, "(SV*)$svsym"));
+    savesym($op, sprintf("(OP*)&svop_list[%d]", $svopsect->index));
+}
+
+sub B::GVOP::save {
+    my ($op, $level) = @_;
+    my $gvsym = $op->gv->save;
+    $gvopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, Nullgv",
+			   ${$op->next}, ${$op->sibling}, $op->ppaddr,
+			   $op->targ, $op->type, $op_seq, $op->flags,
+			   $op->private));
+    $init->add(sprintf("gvop_list[%d].op_gv = %s;", $gvopsect->index, $gvsym));
+    savesym($op, sprintf("(OP*)&gvop_list[%d]", $gvopsect->index));
+}
+
+sub B::COP::save {
+    my ($op, $level) = @_;
+    my $gvsym = $op->filegv->save;
+    my $stashsym = $op->stash->save;
+    warn sprintf("COP: line %d file %s\n", $op->line, $op->filegv->SV->PV)
+	if $debug_cops;
+    $copsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, %s, Nullhv, Nullgv, %u, %d, %u",
+			  ${$op->next}, ${$op->sibling}, $op->ppaddr,
+			  $op->targ, $op->type, $op_seq, $op->flags,
+			  $op->private, cstring($op->label), $op->cop_seq,
+			  $op->arybase, $op->line));
+    my $copix = $copsect->index;
+    $init->add(sprintf("cop_list[%d].cop_filegv = %s;", $copix, $gvsym),
+	       sprintf("cop_list[%d].cop_stash = %s;", $copix, $stashsym));
+    savesym($op, "(OP*)&cop_list[$copix]");
+}
+
+sub B::PMOP::save {
+    my ($op, $level) = @_;
+    my $replroot = $op->pmreplroot;
+    my $replstart = $op->pmreplstart;
+    my $replrootfield = sprintf("s\\_%x", $$replroot);
+    my $replstartfield = sprintf("s\\_%x", $$replstart);
+    my $gvsym;
+    my $ppaddr = $op->ppaddr;
+    if ($$replroot) {
+	# OP_PUSHRE (a mutated version of OP_MATCH for the regexp
+	# argument to a split) stores a GV in op_pmreplroot instead
+	# of a substitution syntax tree. We don't want to walk that...
+	if ($ppaddr eq "pp_pushre") {
+	    $gvsym = $replroot->save;
+#	    warn "PMOP::save saving a pp_pushre with GV $gvsym\n"; # debug
+	    $replrootfield = 0;
+	} else {
+	    $replstartfield = saveoptree("*ignore*", $replroot, $replstart);
+	}
+    }
+    # pmnext handling is broken in perl itself, I think. Bad op_pmnext
+    # fields aren't noticed in perl's runtime (unless you try reset) but we
+    # segfault when trying to dereference it to find op->op_pmnext->op_type
+    $pmopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x, %u, %s, %s, 0, 0, 0x%x, 0x%x",
+			   ${$op->next}, ${$op->sibling}, $ppaddr, $op->targ,
+			   $op->type, $op_seq, $op->flags, $op->private,
+			   ${$op->first}, ${$op->last}, $op->children,
+			   $replrootfield, $replstartfield,
+			   $op->pmflags, $op->pmpermflags,));
+    my $pm = sprintf("pmop_list[%d]", $pmopsect->index);
+    my $re = $op->precomp;
+    if (defined($re)) {
+	my $resym = sprintf("re%d", $re_index++);
+	$decl->add(sprintf("static char *$resym = %s;", cstring($re)));
+	$init->add(sprintf("$pm.op_pmregexp = pregcomp($resym, $resym + %u, &$pm);",
+			   length($re)));
+    }
+    if ($gvsym) {
+	$init->add("$pm.op_pmreplroot = (OP*)$gvsym;");
+    }
+    savesym($op, sprintf("(OP*)&pmop_list[%d]", $pmopsect->index));
+}
+
+sub B::SPECIAL::save {
+    my ($sv) = @_;
+    # special case: $$sv is not the address but an index into specialsv_list
+#   warn "SPECIAL::save specialsv $$sv\n"; # debug
+    my $sym = $specialsv_name[$$sv];
+    if (!defined($sym)) {
+	confess "unknown specialsv index $$sv passed to B::SPECIAL::save";
+    }
+    return $sym;
+}
+
+sub B::OBJECT::save {}
+
+sub B::NULL::save {
+    my ($sv) = @_;
+    my $sym = objsym($sv);
+    return $sym if defined $sym;
+#   warn "Saving SVt_NULL SV\n"; # debug
+    # debug
+    #if ($$sv == 0) {
+    #	warn "NULL::save for sv = 0 called from @{[(caller(1))[3]]}\n";
+    #}
+    $svsect->add(sprintf("0, %u, 0x%x", $sv->REFCNT + 1, $sv->FLAGS));
+    return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
+}
+
+sub B::IV::save {
+    my ($sv) = @_;
+    my $sym = objsym($sv);
+    return $sym if defined $sym;
+    $xpvivsect->add(sprintf("0, 0, 0, %d", $sv->IVX));
+    $svsect->add(sprintf("&xpviv_list[%d], %lu, 0x%x",
+			 $xpvivsect->index, $sv->REFCNT + 1, $sv->FLAGS));
+    return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
+}
+
+sub B::NV::save {
+    my ($sv) = @_;
+    my $sym = objsym($sv);
+    return $sym if defined $sym;
+    $xpvnvsect->add(sprintf("0, 0, 0, %d, %s", $sv->IVX, $sv->NVX));
+    $svsect->add(sprintf("&xpvnv_list[%d], %lu, 0x%x",
+			 $xpvnvsect->index, $sv->REFCNT + 1, $sv->FLAGS));
+    return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
+}
+
+sub B::PVLV::save {
+    my ($sv) = @_;
+    my $sym = objsym($sv);
+    return $sym if defined $sym;
+    my $pv = $sv->PV;
+    my $len = length($pv);
+    my ($pvsym, $pvmax) = savepv($pv);
+    my ($lvtarg, $lvtarg_sym);
+    $xpvlvsect->add(sprintf("%s, %u, %u, %d, %g, 0, 0, %u, %u, 0, %s",
+			    $pvsym, $len, $pvmax, $sv->IVX, $sv->NVX, 
+			    $sv->TARGOFF, $sv->TARGLEN, cchar($sv->TYPE)));
+    $svsect->add(sprintf("&xpvlv_list[%d], %lu, 0x%x",
+			 $xpvlvsect->index, $sv->REFCNT + 1, $sv->FLAGS));
+    if (!$pv_copy_on_grow) {
+	$init->add(sprintf("xpvlv_list[%d].xpv_pv = savepvn(%s, %u);",
+			   $xpvlvsect->index, cstring($pv), $len));
+    }
+    $sv->save_magic;
+    return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
+}
+
+sub B::PVIV::save {
+    my ($sv) = @_;
+    my $sym = objsym($sv);
+    return $sym if defined $sym;
+    my $pv = $sv->PV;
+    my $len = length($pv);
+    my ($pvsym, $pvmax) = savepv($pv);
+    $xpvivsect->add(sprintf("%s, %u, %u, %d", $pvsym, $len, $pvmax, $sv->IVX));
+    $svsect->add(sprintf("&xpviv_list[%d], %u, 0x%x",
+			 $xpvivsect->index, $sv->REFCNT + 1, $sv->FLAGS));
+    if (!$pv_copy_on_grow) {
+	$init->add(sprintf("xpviv_list[%d].xpv_pv = savepvn(%s, %u);",
+			   $xpvivsect->index, cstring($pv), $len));
+    }
+    return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
+}
+
+sub B::PVNV::save {
+    my ($sv) = @_;
+    my $sym = objsym($sv);
+    return $sym if defined $sym;
+    my $pv = $sv->PV;
+    my $len = length($pv);
+    my ($pvsym, $pvmax) = savepv($pv);
+    $xpvnvsect->add(sprintf("%s, %u, %u, %d, %s",
+			    $pvsym, $len, $pvmax, $sv->IVX, $sv->NVX));
+    $svsect->add(sprintf("&xpvnv_list[%d], %lu, 0x%x",
+			 $xpvnvsect->index, $sv->REFCNT + 1, $sv->FLAGS));
+    if (!$pv_copy_on_grow) {
+	$init->add(sprintf("xpvnv_list[%d].xpv_pv = savepvn(%s,%u);",
+			   $xpvnvsect->index, cstring($pv), $len));
+    }
+    return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
+}
+
+sub B::BM::save {
+    my ($sv) = @_;
+    my $sym = objsym($sv);
+    return $sym if defined $sym;
+    my $pv = $sv->PV . "\0" . $sv->TABLE;
+    my $len = length($pv);
+    $xpvbmsect->add(sprintf("0, %u, %u, %d, %s, 0, 0, %d, %u, 0x%x",
+			    $len, $len + 258, $sv->IVX, $sv->NVX,
+			    $sv->USEFUL, $sv->PREVIOUS, $sv->RARE));
+    $svsect->add(sprintf("&xpvbm_list[%d], %lu, 0x%x",
+			 $xpvbmsect->index, $sv->REFCNT + 1, $sv->FLAGS));
+    $sv->save_magic;
+    $init->add(sprintf("xpvbm_list[%d].xpv_pv = savepvn(%s, %u);",
+		       $xpvbmsect->index, cstring($pv), $len),
+	       sprintf("xpvbm_list[%d].xpv_cur = %u;",
+		       $xpvbmsect->index, $len - 257));
+    return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
+}
+
+sub B::PV::save {
+    my ($sv) = @_;
+    my $sym = objsym($sv);
+    return $sym if defined $sym;
+    my $pv = $sv->PV;
+    my $len = length($pv);
+    my ($pvsym, $pvmax) = savepv($pv);
+    $xpvsect->add(sprintf("%s, %u, %u", $pvsym, $len, $pvmax));
+    $svsect->add(sprintf("&xpv_list[%d], %lu, 0x%x",
+			 $xpvsect->index, $sv->REFCNT + 1, $sv->FLAGS));
+    if (!$pv_copy_on_grow) {
+	$init->add(sprintf("xpv_list[%d].xpv_pv = savepvn(%s, %u);",
+			   $xpvsect->index, cstring($pv), $len));
+    }
+    return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
+}
+
+sub B::PVMG::save {
+    my ($sv) = @_;
+    my $sym = objsym($sv);
+    return $sym if defined $sym;
+    my $pv = $sv->PV;
+    my $len = length($pv);
+    my ($pvsym, $pvmax) = savepv($pv);
+    $xpvmgsect->add(sprintf("%s, %u, %u, %d, %s, 0, 0",
+			    $pvsym, $len, $pvmax, $sv->IVX, $sv->NVX));
+    $svsect->add(sprintf("&xpvmg_list[%d], %lu, 0x%x",
+			 $xpvmgsect->index, $sv->REFCNT + 1, $sv->FLAGS));
+    if (!$pv_copy_on_grow) {
+	$init->add(sprintf("xpvmg_list[%d].xpv_pv = savepvn(%s, %u);",
+			   $xpvmgsect->index, cstring($pv), $len));
+    }
+    $sym = savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
+    $sv->save_magic;
+    return $sym;
+}
+
+sub B::PVMG::save_magic {
+    my ($sv) = @_;
+    #warn sprintf("saving magic for %s (0x%x)\n", class($sv), $$sv); # debug
+    my $stash = $sv->SvSTASH;
+    if ($$stash) {
+	warn sprintf("xmg_stash = %s (0x%x)\n", $stash->NAME, $$stash)
+	    if $debug_mg;
+	# XXX Hope stash is already going to be saved.
+	$init->add(sprintf("SvSTASH(s\\_%x) = s\\_%x;", $$sv, $$stash));
+    }
+    my @mgchain = $sv->MAGIC;
+    my ($mg, $type, $obj, $ptr);
+    foreach $mg (@mgchain) {
+	$type = $mg->TYPE;
+	$obj = $mg->OBJ;
+	$ptr = $mg->PTR;
+	my $len = defined($ptr) ? length($ptr) : 0;
+	if ($debug_mg) {
+	    warn sprintf("magic %s (0x%x), obj %s (0x%x), type %s, ptr %s\n",
+			 class($sv), $$sv, class($obj), $$obj,
+			 cchar($type), cstring($ptr));
+	}
+	$init->add(sprintf("sv_magic((SV*)s\\_%x, (SV*)s\\_%x, %s, %s, %d);",
+			   $$sv, $$obj, cchar($type),cstring($ptr),$len));
+    }
+}
+
+sub B::RV::save {
+    my ($sv) = @_;
+    my $sym = objsym($sv);
+    return $sym if defined $sym;
+    $xrvsect->add($sv->RV->save);
+    $svsect->add(sprintf("&xrv_list[%d], %lu, 0x%x",
+			 $xrvsect->index, $sv->REFCNT + 1, $sv->FLAGS));
+    return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
+}
+
+sub try_autoload {
+    my ($cvstashname, $cvname) = @_;
+    warn sprintf("No definition for sub %s::%s\n", $cvstashname, $cvname);
+    # Handle AutoLoader classes explicitly. Any more general AUTOLOAD
+    # use should be handled by the class itself.
+    no strict 'refs';
+    my $isa = \@{"$cvstashname\::ISA"};
+    if (grep($_ eq "AutoLoader", @$isa)) {
+	warn "Forcing immediate load of sub derived from AutoLoader\n";
+	# Tweaked version of AutoLoader::AUTOLOAD
+	my $dir = $cvstashname;
+	$dir =~ s(::)(/)g;
+	eval { require "auto/$dir/$cvname.al" };
+	if ($@) {
+	    warn qq(failed require "auto/$dir/$cvname.al": $@\n);
+	    return 0;
+	} else {
+	    return 1;
+	}
+    }
+}
+
+sub B::CV::save {
+    my ($cv) = @_;
+    my $sym = objsym($cv);
+    if (defined($sym)) {
+#	warn sprintf("CV 0x%x already saved as $sym\n", $$cv); # debug
+	return $sym;
+    }
+    # Reserve a place in svsect and xpvcvsect and record indices
+    my $sv_ix = $svsect->index + 1;
+    $svsect->add("svix$sv_ix");
+    my $xpvcv_ix = $xpvcvsect->index + 1;
+    $xpvcvsect->add("xpvcvix$xpvcv_ix");
+    # Save symbol now so that GvCV() doesn't recurse back to us via CvGV()
+    $sym = savesym($cv, "&sv_list[$sv_ix]");
+    warn sprintf("saving CV 0x%x as $sym\n", $$cv) if $debug_cv;
+    my $gv = $cv->GV;
+    my $cvstashname = $gv->STASH->NAME;
+    my $cvname = $gv->NAME;
+    my $root = $cv->ROOT;
+    my $cvxsub = $cv->XSUB;
+    if (!$$root && !$cvxsub) {
+	if (try_autoload($cvstashname, $cvname)) {
+	    # Recalculate root and xsub
+	    $root = $cv->ROOT;
+	    $cvxsub = $cv->XSUB;
+	    if ($$root || $cvxsub) {
+		warn "Successful forced autoload\n";
+	    }
+	}
+    }
+    my $startfield = 0;
+    my $padlist = $cv->PADLIST;
+    my $pv = $cv->PV;
+    my $xsub = 0;
+    my $xsubany = "Nullany";
+    if ($$root) {
+	warn sprintf("saving op tree for CV 0x%x, root = 0x%x\n",
+		     $$cv, $$root) if $debug_cv;
+	my $ppname = "";
+	if ($$gv) {
+	    my $stashname = $gv->STASH->NAME;
+	    my $gvname = $gv->NAME;
+	    if ($gvname ne "__ANON__") {
+		$ppname = (${$gv->FORM} == $$cv) ? "pp_form_" : "pp_sub_";
+		$ppname .= ($stashname eq "main") ?
+			    $gvname : "$stashname\::$gvname";
+		$ppname =~ s/::/__/g;
+	    }
+	}
+	if (!$ppname) {
+	    $ppname = "pp_anonsub_$anonsub_index";
+	    $anonsub_index++;
+	}
+	$startfield = saveoptree($ppname, $root, $cv->START, $padlist->ARRAY);
+	warn sprintf("done saving op tree for CV 0x%x, name %s, root 0x%x\n",
+		     $$cv, $ppname, $$root) if $debug_cv;
+	if ($$padlist) {
+	    warn sprintf("saving PADLIST 0x%x for CV 0x%x\n",
+			 $$padlist, $$cv) if $debug_cv;
+	    $padlist->save;
+	    warn sprintf("done saving PADLIST 0x%x for CV 0x%x\n",
+			 $$padlist, $$cv) if $debug_cv;
+	}
+    }
+    elsif ($cvxsub) {
+	$xsubany = sprintf("ANYINIT((void*)0x%x)", $cv->XSUBANY);
+	# Try to find out canonical name of XSUB function from EGV.
+	# XXX Doesn't work for XSUBs with PREFIX set (or anyone who
+	# calls newXS() manually with weird arguments).
+	my $egv = $gv->EGV;
+	my $stashname = $egv->STASH->NAME;
+	$stashname =~ s/::/__/g;
+	$xsub = sprintf("XS_%s_%s", $stashname, $egv->NAME);
+	$decl->add("void $xsub _((CV*));");
+    }
+    else {
+	warn sprintf("No definition for sub %s::%s (unable to autoload)\n",
+		     $cvstashname, $cvname); # debug
+    }
+    $symsect->add(sprintf("xpvcvix%d\t%s, %u, 0, %d, %s, 0, Nullhv, Nullhv, %s, s\\_%x, $xsub, $xsubany, Nullgv, Nullgv, %d, s\\_%x, (CV*)s\\_%x, 0",
+			  $xpvcv_ix, cstring($pv), length($pv), $cv->IVX,
+			  $cv->NVX, $startfield, ${$cv->ROOT}, $cv->DEPTH,
+			  $$padlist, ${$cv->OUTSIDE}));
+    if ($$gv) {
+	$gv->save;
+	$init->add(sprintf("CvGV(s\\_%x) = s\\_%x;",$$cv,$$gv));
+	warn sprintf("done saving GV 0x%x for CV 0x%x\n",
+		     $$gv, $$cv) if $debug_cv;
+    }
+    my $filegv = $cv->FILEGV;
+    if ($$filegv) {
+	$filegv->save;
+	$init->add(sprintf("CvFILEGV(s\\_%x) = s\\_%x;", $$cv, $$filegv));
+	warn sprintf("done saving FILEGV 0x%x for CV 0x%x\n",
+		     $$filegv, $$cv) if $debug_cv;
+    }
+    my $stash = $cv->STASH;
+    if ($$stash) {
+	$stash->save;
+	$init->add(sprintf("CvSTASH(s\\_%x) = s\\_%x;", $$cv, $$stash));
+	warn sprintf("done saving STASH 0x%x for CV 0x%x\n",
+		     $$stash, $$cv) if $debug_cv;
+    }
+    $symsect->add(sprintf("svix%d\t(XPVCV*)&xpvcv_list[%u], %lu, 0x%x",
+			  $sv_ix, $xpvcv_ix, $cv->REFCNT + 1, $cv->FLAGS));
+    return $sym;
+}
+
+sub B::GV::save {
+    my ($gv) = @_;
+    my $sym = objsym($gv);
+    if (defined($sym)) {
+	#warn sprintf("GV 0x%x already saved as $sym\n", $$gv); # debug
+	return $sym;
+    } else {
+	my $ix = $gv_index++;
+	$sym = savesym($gv, "gv_list[$ix]");
+	#warn sprintf("Saving GV 0x%x as $sym\n", $$gv); # debug
+    }
+    my $gvname = $gv->NAME;
+    my $name = cstring($gv->STASH->NAME . "::" . $gvname);
+    #warn "GV name is $name\n"; # debug
+    my $egv = $gv->EGV;
+    my $egvsym;
+    if ($$gv != $$egv) {
+	#warn(sprintf("EGV name is %s, saving it now\n",
+	#	     $egv->STASH->NAME . "::" . $egv->NAME)); # debug
+	$egvsym = $egv->save;
+    }
+    $init->add(qq[$sym = gv_fetchpv($name, TRUE, SVt_PV);],
+	       sprintf("SvFLAGS($sym) = 0x%x;", $gv->FLAGS),
+	       sprintf("GvFLAGS($sym) = 0x%x;", $gv->GvFLAGS),
+	       sprintf("GvLINE($sym) = %u;", $gv->LINE));
+    # Shouldn't need to do save_magic since gv_fetchpv handles that
+    #$gv->save_magic;
+    my $refcnt = $gv->REFCNT + 1;
+    $init->add(sprintf("SvREFCNT($sym) += %u;", $refcnt - 1)) if $refcnt > 1;
+    my $gvrefcnt = $gv->GvREFCNT;
+    if ($gvrefcnt > 1) {
+	$init->add(sprintf("GvREFCNT($sym) += %u;", $gvrefcnt - 1));
+    }
+    if (defined($egvsym)) {
+	# Shared glob *foo = *bar
+	$init->add("gp_free($sym);",
+		   "GvGP($sym) = GvGP($egvsym);");
+    } elsif ($gvname !~ /^([^A-Za-z]|STDIN|STDOUT|STDERR|ARGV|SIG|ENV)$/) {
+	# Don't save subfields of special GVs (*_, *1, *# and so on)
+#	warn "GV::save saving subfields\n"; # debug
+	my $gvsv = $gv->SV;
+	if ($$gvsv) {
+	    $init->add(sprintf("GvSV($sym) = s\\_%x;", $$gvsv));
+#	    warn "GV::save \$$name\n"; # debug
+	    $gvsv->save;
+	}
+	my $gvav = $gv->AV;
+	if ($$gvav) {
+	    $init->add(sprintf("GvAV($sym) = s\\_%x;", $$gvav));
+#	    warn "GV::save \@$name\n"; # debug
+	    $gvav->save;
+	}
+	my $gvhv = $gv->HV;
+	if ($$gvhv) {
+	    $init->add(sprintf("GvHV($sym) = s\\_%x;", $$gvhv));
+#	    warn "GV::save \%$name\n"; # debug
+	    $gvhv->save;
+	}
+	my $gvcv = $gv->CV;
+	if ($$gvcv) {
+	    $init->add(sprintf("GvCV($sym) = (CV*)s\\_%x;", $$gvcv));
+#	    warn "GV::save &$name\n"; # debug
+	    $gvcv->save;
+	}
+	my $gvfilegv = $gv->FILEGV;
+	if ($$gvfilegv) {
+	    $init->add(sprintf("GvFILEGV($sym) = s\\_%x;",$$gvfilegv));
+#	    warn "GV::save GvFILEGV(*$name)\n"; # debug
+	    $gvfilegv->save;
+	}
+	my $gvform = $gv->FORM;
+	if ($$gvform) {
+	    $init->add(sprintf("GvFORM($sym) = (CV*)s\\_%x;", $$gvform));
+#	    warn "GV::save GvFORM(*$name)\n"; # debug
+	    $gvform->save;
+	}
+	my $gvio = $gv->IO;
+	if ($$gvio) {
+	    $init->add(sprintf("GvIOp($sym) = s\\_%x;", $$gvio));
+#	    warn "GV::save GvIO(*$name)\n"; # debug
+	    $gvio->save;
+	}
+    }
+    return $sym;
+}
+sub B::AV::save {
+    my ($av) = @_;
+    my $sym = objsym($av);
+    return $sym if defined $sym;
+    my $avflags = $av->AvFLAGS;
+    $xpvavsect->add(sprintf("0, -1, -1, 0, 0.0, 0, Nullhv, 0, 0, 0x%x",
+			    $avflags));
+    $svsect->add(sprintf("&xpvav_list[%d], %lu, 0x%x",
+			 $xpvavsect->index, $av->REFCNT + 1, $av->FLAGS));
+    my $sv_list_index = $svsect->index;
+    my $fill = $av->FILL;
+    $av->save_magic;
+    warn sprintf("saving AV 0x%x FILL=$fill AvFLAGS=0x%x", $$av, $avflags)
+	if $debug_av;
+    # XXX AVf_REAL is wrong test: need to save comppadlist but not stack
+    #if ($fill > -1 && ($avflags & AVf_REAL)) {
+    if ($fill > -1) {
+	my @array = $av->ARRAY;
+	if ($debug_av) {
+	    my $el;
+	    my $i = 0;
+	    foreach $el (@array) {
+		warn sprintf("AV 0x%x[%d] = %s 0x%x\n",
+			     $$av, $i++, class($el), $$el);
+	    }
+	}
+	my @names = map($_->save, @array);
+	# XXX Better ways to write loop?
+	# Perhaps svp[0] = ...; svp[1] = ...; svp[2] = ...;
+	# Perhaps I32 i = 0; svp[i++] = ...; svp[i++] = ...; svp[i++] = ...;
+	$init->add("{",
+		   "\tSV **svp;",
+		   "\tAV *av = (AV*)&sv_list[$sv_list_index];",
+		   "\tav_extend(av, $fill);",
+		   "\tsvp = AvARRAY(av);",
+	       map("\t*svp++ = (SV*)$_;", @names),
+		   "\tAvFILLp(av) = $fill;",
+		   "}");
+    } else {
+	my $max = $av->MAX;
+	$init->add("av_extend((AV*)&sv_list[$sv_list_index], $max);")
+	    if $max > -1;
+    }
+    return savesym($av, "(AV*)&sv_list[$sv_list_index]");
+}
+
+sub B::HV::save {
+    my ($hv) = @_;
+    my $sym = objsym($hv);
+    return $sym if defined $sym;
+    my $name = $hv->NAME;
+    if ($name) {
+	# It's a stash
+
+	# A perl bug means HvPMROOT isn't altered when a PMOP is freed. Usually
+	# the only symptom is that sv_reset tries to reset the PMf_USED flag of
+	# a trashed op but we look at the trashed op_type and segfault.
+	#my $adpmroot = ${$hv->PMROOT};
+	my $adpmroot = 0;
+	$decl->add("static HV *hv$hv_index;");
+	# XXX Beware of weird package names containing double-quotes, \n, ...?
+	$init->add(qq[hv$hv_index = gv_stashpv("$name", TRUE);]);
+	if ($adpmroot) {
+	    $init->add(sprintf("HvPMROOT(hv$hv_index) = (PMOP*)s\\_%x;",
+			       $adpmroot));
+	}
+	$sym = savesym($hv, "hv$hv_index");
+	$hv_index++;
+	return $sym;
+    }
+    # It's just an ordinary HV
+    $xpvhvsect->add(sprintf("0, 0, %d, 0, 0.0, 0, Nullhv, %d, 0, 0, 0",
+			    $hv->MAX, $hv->RITER));
+    $svsect->add(sprintf("&xpvhv_list[%d], %lu, 0x%x",
+			 $xpvhvsect->index, $hv->REFCNT + 1, $hv->FLAGS));
+    my $sv_list_index = $svsect->index;
+    my @contents = $hv->ARRAY;
+    if (@contents) {
+	my $i;
+	for ($i = 1; $i < @contents; $i += 2) {
+	    $contents[$i] = $contents[$i]->save;
+	}
+	$init->add("{", "\tHV *hv = (HV*)&sv_list[$sv_list_index];");
+	while (@contents) {
+	    my ($key, $value) = splice(@contents, 0, 2);
+	    $init->add(sprintf("\thv_store(hv, %s, %u, %s, %s);",
+			       cstring($key),length($key),$value, hash($key)));
+	}
+	$init->add("}");
+    }
+    return savesym($hv, "(HV*)&sv_list[$sv_list_index]");
+}
+
+sub B::IO::save {
+    my ($io) = @_;
+    my $sym = objsym($io);
+    return $sym if defined $sym;
+    my $pv = $io->PV;
+    my $len = length($pv);
+    $xpviosect->add(sprintf("0, %u, %u, %d, %s, 0, 0, 0, 0, 0, %d, %d, %d, %d, %s, Nullgv, %s, Nullgv, %s, Nullgv, %d, %s, 0x%x",
+			    $len, $len+1, $io->IVX, $io->NVX, $io->LINES,
+			    $io->PAGE, $io->PAGE_LEN, $io->LINES_LEFT,
+			    cstring($io->TOP_NAME), cstring($io->FMT_NAME), 
+			    cstring($io->BOTTOM_NAME), $io->SUBPROCESS,
+			    cchar($io->IoTYPE), $io->IoFLAGS));
+    $svsect->add(sprintf("&xpvio_list[%d], %lu, 0x%x",
+			 $xpviosect->index, $io->REFCNT + 1, $io->FLAGS));
+    $sym = savesym($io, sprintf("(IO*)&sv_list[%d]", $svsect->index));
+    my ($field, $fsym);
+    foreach $field (qw(TOP_GV FMT_GV BOTTOM_GV)) {
+      	$fsym = $io->$field();
+	if ($$fsym) {
+	    $init->add(sprintf("Io$field($sym) = (GV*)s\\_%x;", $$fsym));
+	    $fsym->save;
+	}
+    }
+    $io->save_magic;
+    return $sym;
+}
+
+sub B::SV::save {
+    my $sv = shift;
+    # This is where we catch an honest-to-goodness Nullsv (which gets
+    # blessed into B::SV explicitly) and any stray erroneous SVs.
+    return 0 unless $$sv;
+    confess sprintf("cannot save that type of SV: %s (0x%x)\n",
+		    class($sv), $$sv);
+}
+
+sub output_all {
+    my $init_name = shift;
+    my $section;
+    my @sections = ($opsect, $unopsect, $binopsect, $logopsect, $condopsect,
+		    $listopsect, $pmopsect, $svopsect, $gvopsect, $pvopsect,
+		    $cvopsect, $loopsect, $copsect, $svsect, $xpvsect,
+		    $xpvavsect, $xpvhvsect, $xpvcvsect, $xpvivsect, $xpvnvsect,
+		    $xpvmgsect, $xpvlvsect, $xrvsect, $xpvbmsect, $xpviosect);
+    $symsect->output(\*STDOUT, "#define %s\n");
+    print "\n";
+    output_declarations();
+    foreach $section (@sections) {
+	my $lines = $section->index + 1;
+	if ($lines) {
+	    my $name = $section->name;
+	    my $typename = ($name eq "xpvcv") ? "XPVCV_or_similar" : uc($name);
+	    print "Static $typename ${name}_list[$lines];\n";
+	}
+    }
+    $decl->output(\*STDOUT, "%s\n");
+    print "\n";
+    foreach $section (@sections) {
+	my $lines = $section->index + 1;
+	if ($lines) {
+	    my $name = $section->name;
+	    my $typename = ($name eq "xpvcv") ? "XPVCV_or_similar" : uc($name);
+	    printf "static %s %s_list[%u] = {\n", $typename, $name, $lines;
+	    $section->output(\*STDOUT, "\t{ %s },\n");
+	    print "};\n\n";
+	}
+    }
+
+    print <<"EOT";
+static int $init_name()
+{
+	dTHR;
+EOT
+    $init->output(\*STDOUT, "\t%s\n");
+    print "\treturn 0;\n}\n";
+    if ($verbose) {
+	warn compile_stats();
+	warn "NULLOP count: $nullop_count\n";
+    }
+}
+
+sub output_declarations {
+    print <<'EOT';
+#ifdef BROKEN_STATIC_REDECL
+#define Static extern
+#else
+#define Static static
+#endif /* BROKEN_STATIC_REDECL */
+
+#ifdef BROKEN_UNION_INIT
+/*
+ * Cribbed from cv.h with ANY (a union) replaced by void*.
+ * Some pre-Standard compilers can't cope with initialising unions. Ho hum.
+ */
+typedef struct {
+    char *	xpv_pv;		/* pointer to malloced string */
+    STRLEN	xpv_cur;	/* length of xp_pv as a C string */
+    STRLEN	xpv_len;	/* allocated size */
+    IV		xof_off;	/* integer value */
+    double	xnv_nv;		/* numeric value, if any */
+    MAGIC*	xmg_magic;	/* magic for scalar array */
+    HV*		xmg_stash;	/* class package */
+
+    HV *	xcv_stash;
+    OP *	xcv_start;
+    OP *	xcv_root;
+    void      (*xcv_xsub) _((CV*));
+    void *	xcv_xsubany;
+    GV *	xcv_gv;
+    GV *	xcv_filegv;
+    long	xcv_depth;		/* >= 2 indicates recursive call */
+    AV *	xcv_padlist;
+    CV *	xcv_outside;
+#ifdef USE_THREADS
+    perl_mutex *xcv_mutexp;
+    struct perl_thread *xcv_owner;	/* current owner thread */
+#endif /* USE_THREADS */
+    U8		xcv_flags;
+} XPVCV_or_similar;
+#define ANYINIT(i) i
+#else
+#define XPVCV_or_similar XPVCV
+#define ANYINIT(i) {i}
+#endif /* BROKEN_UNION_INIT */
+#define Nullany ANYINIT(0)
+
+#define UNUSED 0
+#define sym_0 0
+
+EOT
+    print "static GV *gv_list[$gv_index];\n" if $gv_index;
+    print "\n";
+}
+
+
+sub output_boilerplate {
+    print <<'EOT';
+#include "EXTERN.h"
+#include "perl.h"
+#ifndef PATCHLEVEL
+#include "patchlevel.h"
+#endif
+
+/* Workaround for mapstart: the only op which needs a different ppaddr */
+#undef pp_mapstart
+#define pp_mapstart pp_grepstart
+
+static void xs_init _((void));
+static PerlInterpreter *my_perl;
+EOT
+}
+
+sub output_main {
+    print <<'EOT';
+int
+#ifndef CAN_PROTOTYPE
+main(argc, argv, env)
+int argc;
+char **argv;
+char **env;
+#else  /* def(CAN_PROTOTYPE) */
+main(int argc, char **argv, char **env)
+#endif  /* def(CAN_PROTOTYPE) */
+{
+    int exitstatus;
+    int i;
+    char **fakeargv;
+
+    PERL_SYS_INIT(&argc,&argv);
+ 
+    perl_init_i18nl10n(1);
+
+    if (!PL_do_undump) {
+	my_perl = perl_alloc();
+	if (!my_perl)
+	    exit(1);
+	perl_construct( my_perl );
+    }
+
+#ifdef CSH
+    if (!PL_cshlen) 
+      PL_cshlen = strlen(PL_cshname);
+#endif
+
+#ifdef ALLOW_PERL_OPTIONS
+#define EXTRA_OPTIONS 2
+#else
+#define EXTRA_OPTIONS 3
+#endif /* ALLOW_PERL_OPTIONS */
+    New(666, fakeargv, argc + EXTRA_OPTIONS + 1, char *);
+    fakeargv[0] = argv[0];
+    fakeargv[1] = "-e";
+    fakeargv[2] = "";
+#ifndef ALLOW_PERL_OPTIONS
+    fakeargv[3] = "--";
+#endif /* ALLOW_PERL_OPTIONS */
+    for (i = 1; i < argc; i++)
+	fakeargv[i + EXTRA_OPTIONS] = argv[i];
+    fakeargv[argc + EXTRA_OPTIONS] = 0;
+    
+    exitstatus = perl_parse(my_perl, xs_init, argc + EXTRA_OPTIONS,
+			    fakeargv, NULL);
+    if (exitstatus)
+	exit( exitstatus );
+
+    sv_setpv(GvSV(gv_fetchpv("0", TRUE, SVt_PV)), argv[0]);
+    PL_main_cv = PL_compcv;
+    PL_compcv = 0;
+
+    exitstatus = perl_init();
+    if (exitstatus)
+	exit( exitstatus );
+
+    exitstatus = perl_run( my_perl );
+
+    perl_destruct( my_perl );
+    perl_free( my_perl );
+
+    exit( exitstatus );
+}
+
+static void
+xs_init()
+{
+}
+EOT
+}
+
+sub dump_symtable {
+    # For debugging
+    my ($sym, $val);
+    warn "----Symbol table:\n";
+    while (($sym, $val) = each %symtable) {
+	warn "$sym => $val\n";
+    }
+    warn "---End of symbol table\n";
+}
+
+sub save_object {
+    my $sv;
+    foreach $sv (@_) {
+	svref_2object($sv)->save;
+    }
+}
+
+sub B::GV::savecv {
+    my $gv = shift;
+    my $cv = $gv->CV;
+    my $name = $gv->NAME;
+    if ($$cv && !objsym($cv) && !($name eq "bootstrap" && $cv->XSUB)) {
+	if ($debug_cv) {
+	    warn sprintf("saving extra CV &%s::%s (0x%x) from GV 0x%x\n",
+			 $gv->STASH->NAME, $name, $$cv, $$gv);
+	}
+	$gv->save;
+    }
+}
+
+sub save_unused_subs {
+    my %search_pack;
+    map { $search_pack{$_} = 1 } @_;
+    no strict qw(vars refs);
+    walksymtable(\%{"main::"}, "savecv", sub {
+	my $package = shift;
+	$package =~ s/::$//;
+	#warn "Considering $package\n";#debug
+	return 1 if exists $search_pack{$package};
+	#warn "    (nothing explicit)\n";#debug
+	# Omit the packages which we use (and which cause grief
+	# because of fancy "goto &$AUTOLOAD" stuff).
+	# XXX Surely there must be a nicer way to do this.
+	if ($package eq "FileHandle"
+	    || $package eq "Config"
+	    || $package eq "SelectSaver") {
+	    return 0;
+	}
+	my $m;
+	foreach $m (qw(new DESTROY TIESCALAR TIEARRAY TIEHASH)) {
+	    if (defined(&{$package."::$m"})) {
+		warn "$package has method $m: -u$package assumed\n";#debug
+		return 1;
+	    }
+	}
+	return 0;
+    });
+}
+
+sub save_main {
+    my $curpad_sym = (comppadlist->ARRAY)[1]->save;
+    walkoptree(main_root, "save");
+    warn "done main optree, walking symtable for extras\n" if $debug_cv;
+    save_unused_subs(@unused_sub_packages);
+
+    $init->add(sprintf("PL_main_root = s\\_%x;", ${main_root()}),
+	       sprintf("PL_main_start = s\\_%x;", ${main_start()}),
+	       "PL_curpad = AvARRAY($curpad_sym);");
+    output_boilerplate();
+    print "\n";
+    output_all("perl_init");
+    print "\n";
+    output_main();
+}
+
+sub init_sections {
+    my @sections = (init => \$init, decl => \$decl, sym => \$symsect,
+		    binop => \$binopsect, condop => \$condopsect,
+		    cop => \$copsect, cvop => \$cvopsect, gvop => \$gvopsect,
+		    listop => \$listopsect, logop => \$logopsect,
+		    loop => \$loopsect, op => \$opsect, pmop => \$pmopsect,
+		    pvop => \$pvopsect, svop => \$svopsect, unop => \$unopsect,
+		    sv => \$svsect, xpv => \$xpvsect, xpvav => \$xpvavsect,
+		    xpvhv => \$xpvhvsect, xpvcv => \$xpvcvsect,
+		    xpviv => \$xpvivsect, xpvnv => \$xpvnvsect,
+		    xpvmg => \$xpvmgsect, xpvlv => \$xpvlvsect,
+		    xrv => \$xrvsect, xpvbm => \$xpvbmsect,
+		    xpvio => \$xpviosect);
+    my ($name, $sectref);
+    while (($name, $sectref) = splice(@sections, 0, 2)) {
+	$$sectref = new B::Section $name, \%symtable, 0;
+    }
+}
+
+sub compile {
+    my @options = @_;
+    my ($option, $opt, $arg);
+  OPTION:
+    while ($option = shift @options) {
+	if ($option =~ /^-(.)(.*)/) {
+	    $opt = $1;
+	    $arg = $2;
+	} else {
+	    unshift @options, $option;
+	    last OPTION;
+	}
+	if ($opt eq "-" && $arg eq "-") {
+	    shift @options;
+	    last OPTION;
+	}
+	if ($opt eq "w") {
+	    $warn_undefined_syms = 1;
+	} elsif ($opt eq "D") {
+	    $arg ||= shift @options;
+	    foreach $arg (split(//, $arg)) {
+		if ($arg eq "o") {
+		    B->debug(1);
+		} elsif ($arg eq "c") {
+		    $debug_cops = 1;
+		} elsif ($arg eq "A") {
+		    $debug_av = 1;
+		} elsif ($arg eq "C") {
+		    $debug_cv = 1;
+		} elsif ($arg eq "M") {
+		    $debug_mg = 1;
+		} else {
+		    warn "ignoring unknown debug option: $arg\n";
+		}
+	    }
+	} elsif ($opt eq "o") {
+	    $arg ||= shift @options;
+	    open(STDOUT, ">$arg") or return "$arg: $!\n";
+	} elsif ($opt eq "v") {
+	    $verbose = 1;
+	} elsif ($opt eq "u") {
+	    $arg ||= shift @options;
+	    push(@unused_sub_packages, $arg);
+	} elsif ($opt eq "f") {
+	    $arg ||= shift @options;
+	    if ($arg eq "cog") {
+		$pv_copy_on_grow = 1;
+	    } elsif ($arg eq "no-cog") {
+		$pv_copy_on_grow = 0;
+	    }
+	} elsif ($opt eq "O") {
+	    $arg = 1 if $arg eq "";
+	    $pv_copy_on_grow = 0;
+	    if ($arg >= 1) {
+		# Optimisations for -O1
+		$pv_copy_on_grow = 1;
+	    }
+	}
+    }
+    init_sections();
+    if (@options) {
+	return sub {
+	    my $objname;
+	    foreach $objname (@options) {
+		eval "save_object(\\$objname)";
+	    }
+	    output_all();
+	}
+    } else {
+	return sub { save_main() };
+    }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+B::C - Perl compiler's C backend
+
+=head1 SYNOPSIS
+
+	perl -MO=C[,OPTIONS] foo.pl
+
+=head1 DESCRIPTION
+
+This compiler backend takes Perl source and generates C source code
+corresponding to the internal structures that perl uses to run
+your program. When the generated C source is compiled and run, it
+cuts out the time which perl would have taken to load and parse
+your program into its internal semi-compiled form. That means that
+compiling with this backend will not help improve the runtime
+execution speed of your program but may improve the start-up time.
+Depending on the environment in which your program runs this may be
+either a help or a hindrance.
+
+=head1 OPTIONS
+
+If there are any non-option arguments, they are taken to be
+names of objects to be saved (probably doesn't work properly yet).
+Without extra arguments, it saves the main program.
+
+=over 4
+
+=item B<-ofilename>
+
+Output to filename instead of STDOUT
+
+=item B<-v>
+
+Verbose compilation (currently gives a few compilation statistics).
+
+=item B<-->
+
+Force end of options
+
+=item B<-uPackname>
+
+Force apparently unused subs from package Packname to be compiled.
+This allows programs to use eval "foo()" even when sub foo is never
+seen to be used at compile time. The down side is that any subs which
+really are never used also have code generated. This option is
+necessary, for example, if you have a signal handler foo which you
+initialise with C<$SIG{BAR} = "foo">.  A better fix, though, is just
+to change it to C<$SIG{BAR} = \&foo>. You can have multiple B<-u>
+options. The compiler tries to figure out which packages may possibly
+have subs in which need compiling but the current version doesn't do
+it very well. In particular, it is confused by nested packages (i.e.
+of the form C<A::B>) where package C<A> does not contain any subs.
+
+=item B<-D>
+
+Debug options (concatenated or separate flags like C<perl -D>).
+
+=item B<-Do>
+
+OPs, prints each OP as it's processed
+
+=item B<-Dc>
+
+COPs, prints COPs as processed (incl. file & line num)
+
+=item B<-DA>
+
+prints AV information on saving
+
+=item B<-DC>
+
+prints CV information on saving
+
+=item B<-DM>
+
+prints MAGIC information on saving
+
+=item B<-f>
+
+Force optimisations on or off one at a time.
+
+=item B<-fcog>
+
+Copy-on-grow: PVs declared and initialised statically.
+
+=item B<-fno-cog>
+
+No copy-on-grow.
+
+=item B<-On>
+
+Optimisation level (n = 0, 1, 2, ...). B<-O> means B<-O1>.  Currently,
+B<-O1> and higher set B<-fcog>.
+
+=head1 EXAMPLES
+
+    perl -MO=C,-ofoo.c foo.pl
+    perl cc_harness -o foo foo.c
+
+Note that C<cc_harness> lives in the C<B> subdirectory of your perl
+library directory. The utility called C<perlcc> may also be used to
+help make use of this compiler.
+
+    perl -MO=C,-v,-DcA bar.pl > /dev/null
+
+=head1 BUGS
+
+Plenty. Current status: experimental.
+
+=head1 AUTHOR
+
+Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
+
+=cut
diff --git a/contrib/perl5/ext/B/B/CC.pm b/contrib/perl5/ext/B/B/CC.pm
new file mode 100644
index 0000000..9991d8e
--- /dev/null
+++ b/contrib/perl5/ext/B/B/CC.pm
@@ -0,0 +1,1734 @@
+#      CC.pm
+#
+#      Copyright (c) 1996, 1997, 1998 Malcolm Beattie
+#
+#      You may distribute under the terms of either the GNU General Public
+#      License or the Artistic License, as specified in the README file.
+#
+package B::CC;
+use strict;
+use B qw(main_start main_root class comppadlist peekop svref_2object
+	timing_info);
+use B::C qw(save_unused_subs objsym init_sections
+	    output_all output_boilerplate output_main);
+use B::Bblock qw(find_leaders);
+use B::Stackobj qw(:types :flags);
+
+# These should probably be elsewhere
+# Flags for $op->flags
+sub OPf_LIST () { 1 }
+sub OPf_KNOW () { 2 }
+sub OPf_MOD () { 32 }
+sub OPf_STACKED () { 64 }
+sub OPf_SPECIAL () { 128 }
+# op-specific flags for $op->private 
+sub OPpASSIGN_BACKWARDS () { 64 }
+sub OPpLVAL_INTRO () { 128 }
+sub OPpDEREF_AV () { 32 }
+sub OPpDEREF_HV () { 64 }
+sub OPpDEREF () { OPpDEREF_AV|OPpDEREF_HV }
+sub OPpFLIP_LINENUM () { 64 }
+sub G_ARRAY () { 1 }
+# cop.h
+sub CXt_NULL () { 0 }
+sub CXt_SUB () { 1 }
+sub CXt_EVAL () { 2 }
+sub CXt_LOOP () { 3 }
+sub CXt_SUBST () { 4 }
+sub CXt_BLOCK () { 5 }
+
+my $module;		# module name (when compiled with -m)
+my %done;		# hash keyed by $$op of leaders of basic blocks
+			# which have already been done.
+my $leaders;		# ref to hash of basic block leaders. Keys are $$op
+			# addresses, values are the $op objects themselves.
+my @bblock_todo;	# list of leaders of basic blocks that need visiting
+			# sometime.
+my @cc_todo;		# list of tuples defining what PP code needs to be
+			# saved (e.g. CV, main or PMOP repl code). Each tuple
+			# is [$name, $root, $start, @padlist]. PMOP repl code
+			# tuples inherit padlist.
+my @stack;		# shadows perl's stack when contents are known.
+			# Values are objects derived from class B::Stackobj
+my @pad;		# Lexicals in current pad as Stackobj-derived objects
+my @padlist;		# Copy of current padlist so PMOP repl code can find it
+my @cxstack;		# Shadows the (compile-time) cxstack for next,last,redo
+my $jmpbuf_ix = 0;	# Next free index for dynamically allocated jmpbufs
+my %constobj;		# OP_CONST constants as Stackobj-derived objects
+			# keyed by $$sv.
+my $need_freetmps = 0;	# We may postpone FREETMPS to the end of each basic
+			# block or even to the end of each loop of blocks,
+			# depending on optimisation options.
+my $know_op = 0;	# Set when C variable op already holds the right op
+			# (from an immediately preceding DOOP(ppname)).
+my $errors = 0;		# Number of errors encountered
+my %skip_stack;		# Hash of PP names which don't need write_back_stack
+my %skip_lexicals;	# Hash of PP names which don't need write_back_lexicals
+my %skip_invalidate;	# Hash of PP names which don't need invalidate_lexicals
+my %ignore_op;		# Hash of ops which do nothing except returning op_next
+
+BEGIN {
+    foreach (qw(pp_scalar pp_regcmaybe pp_lineseq pp_scope pp_null)) {
+	$ignore_op{$_} = 1;
+    }
+}
+
+my @unused_sub_packages; # list of packages (given by -u options) to search
+			 # explicitly and save every sub we find there, even
+			 # if apparently unused (could be only referenced from
+			 # an eval "" or from a $SIG{FOO} = "bar").
+
+my ($module_name);
+my ($debug_op, $debug_stack, $debug_cxstack, $debug_pad, $debug_runtime,
+    $debug_shadow, $debug_queue, $debug_lineno, $debug_timings);
+
+# Optimisation options. On the command line, use hyphens instead of
+# underscores for compatibility with gcc-style options. We use
+# underscores here because they are OK in (strict) barewords.
+my ($freetmps_each_bblock, $freetmps_each_loop, $omit_taint);
+my %optimise = (freetmps_each_bblock	=> \$freetmps_each_bblock,
+		freetmps_each_loop	=> \$freetmps_each_loop,
+		omit_taint		=> \$omit_taint);
+# perl patchlevel to generate code for (defaults to current patchlevel)
+my $patchlevel = int(0.5 + 1000 * ($]  - 5));
+
+# Could rewrite push_runtime() and output_runtime() to use a
+# temporary file if memory is at a premium.
+my $ppname;		# name of current fake PP function
+my $runtime_list_ref;
+my $declare_ref;	# Hash ref keyed by C variable type of declarations.
+
+my @pp_list;		# list of [$ppname, $runtime_list_ref, $declare_ref]
+			# tuples to be written out.
+
+my ($init, $decl);
+
+sub init_hash { map { $_ => 1 } @_ }
+
+#
+# Initialise the hashes for the default PP functions where we can avoid
+# either write_back_stack, write_back_lexicals or invalidate_lexicals.
+#
+%skip_lexicals = init_hash qw(pp_enter pp_enterloop);
+%skip_invalidate = init_hash qw(pp_enter pp_enterloop);
+
+sub debug {
+    if ($debug_runtime) {
+	warn(@_);
+    } else {
+	runtime(map { chomp; "/* $_ */"} @_);
+    }
+}
+
+sub declare {
+    my ($type, $var) = @_;
+    push(@{$declare_ref->{$type}}, $var);
+}
+
+sub push_runtime {
+    push(@$runtime_list_ref, @_);
+    warn join("\n", @_) . "\n" if $debug_runtime;
+}
+
+sub save_runtime {
+    push(@pp_list, [$ppname, $runtime_list_ref, $declare_ref]);
+}
+
+sub output_runtime {
+    my $ppdata;
+    print qq(#include "cc_runtime.h"\n);
+    foreach $ppdata (@pp_list) {
+	my ($name, $runtime, $declare) = @$ppdata;
+	print "\nstatic\nPP($name)\n{\n";
+	my ($type, $varlist, $line);
+	while (($type, $varlist) = each %$declare) {
+	    print "\t$type ", join(", ", @$varlist), ";\n";
+	}
+	foreach $line (@$runtime) {
+	    print $line, "\n";
+	}
+	print "}\n";
+    }
+}
+
+sub runtime {
+    my $line;
+    foreach $line (@_) {
+	push_runtime("\t$line");
+    }
+}
+
+sub init_pp {
+    $ppname = shift;
+    $runtime_list_ref = [];
+    $declare_ref = {};
+    runtime("djSP;");
+    declare("I32", "oldsave");
+    declare("SV", "**svp");
+    map { declare("SV", "*$_") } qw(sv src dst left right);
+    declare("MAGIC", "*mg");
+    $decl->add("static OP * $ppname _((ARGSproto));");
+    debug "init_pp: $ppname\n" if $debug_queue;
+}
+
+# Initialise runtime_callback function for Stackobj class
+BEGIN { B::Stackobj::set_callback(\&runtime) }
+
+# Initialise saveoptree_callback for B::C class
+sub cc_queue {
+    my ($name, $root, $start, @pl) = @_;
+    debug "cc_queue: name $name, root $root, start $start, padlist (@pl)\n"
+	if $debug_queue;
+    if ($name eq "*ignore*") {
+	$name = 0;
+    } else {
+	push(@cc_todo, [$name, $root, $start, (@pl ? @pl : @padlist)]);
+    }
+    my $fakeop = new B::FAKEOP ("next" => 0, sibling => 0, ppaddr => $name);
+    $start = $fakeop->save;
+    debug "cc_queue: name $name returns $start\n" if $debug_queue;
+    return $start;
+}
+BEGIN { B::C::set_callback(\&cc_queue) }
+
+sub valid_int { $_[0]->{flags} & VALID_INT }
+sub valid_double { $_[0]->{flags} & VALID_DOUBLE }
+sub valid_numeric { $_[0]->{flags} & (VALID_INT | VALID_DOUBLE) }
+sub valid_sv { $_[0]->{flags} & VALID_SV }
+
+sub top_int { @stack ? $stack[-1]->as_int : "TOPi" }
+sub top_double { @stack ? $stack[-1]->as_double : "TOPn" }
+sub top_numeric { @stack ? $stack[-1]->as_numeric : "TOPn" }
+sub top_sv { @stack ? $stack[-1]->as_sv : "TOPs" }
+sub top_bool { @stack ? $stack[-1]->as_numeric : "SvTRUE(TOPs)" }
+
+sub pop_int { @stack ? (pop @stack)->as_int : "POPi" }
+sub pop_double { @stack ? (pop @stack)->as_double : "POPn" }
+sub pop_numeric { @stack ? (pop @stack)->as_numeric : "POPn" }
+sub pop_sv { @stack ? (pop @stack)->as_sv : "POPs" }
+sub pop_bool {
+    if (@stack) {
+	return ((pop @stack)->as_numeric);
+    } else {
+	# Careful: POPs has an auto-decrement and SvTRUE evaluates
+	# its argument more than once.
+	runtime("sv = POPs;");
+	return "SvTRUE(sv)";
+    }
+}
+
+sub write_back_lexicals {
+    my $avoid = shift || 0;
+    debug "write_back_lexicals($avoid) called from @{[(caller(1))[3]]}\n"
+	if $debug_shadow;
+    my $lex;
+    foreach $lex (@pad) {
+	next unless ref($lex);
+	$lex->write_back unless $lex->{flags} & $avoid;
+    }
+}
+
+sub write_back_stack {
+    my $obj;
+    return unless @stack;
+    runtime(sprintf("EXTEND(sp, %d);", scalar(@stack)));
+    foreach $obj (@stack) {
+	runtime(sprintf("PUSHs((SV*)%s);", $obj->as_sv));
+    }
+    @stack = ();
+}
+
+sub invalidate_lexicals {
+    my $avoid = shift || 0;
+    debug "invalidate_lexicals($avoid) called from @{[(caller(1))[3]]}\n"
+	if $debug_shadow;
+    my $lex;
+    foreach $lex (@pad) {
+	next unless ref($lex);
+	$lex->invalidate unless $lex->{flags} & $avoid;
+    }
+}
+
+sub reload_lexicals {
+    my $lex;
+    foreach $lex (@pad) {
+	next unless ref($lex);
+	my $type = $lex->{type};
+	if ($type == T_INT) {
+	    $lex->as_int;
+	} elsif ($type == T_DOUBLE) {
+	    $lex->as_double;
+	} else {
+	    $lex->as_sv;
+	}
+    }
+}
+
+{
+    package B::Pseudoreg;
+    #
+    # This class allocates pseudo-registers (OK, so they're C variables).
+    #
+    my %alloc;		# Keyed by variable name. A value of 1 means the
+			# variable has been declared. A value of 2 means
+			# it's in use.
+    
+    sub new_scope { %alloc = () }
+    
+    sub new ($$$) {
+	my ($class, $type, $prefix) = @_;
+	my ($ptr, $i, $varname, $status, $obj);
+	$prefix =~ s/^(\**)//;
+	$ptr = $1;
+	$i = 0;
+	do {
+	    $varname = "$prefix$i";
+	    $status = $alloc{$varname};
+	} while $status == 2;
+	if ($status != 1) {
+	    # Not declared yet
+	    B::CC::declare($type, "$ptr$varname");
+	    $alloc{$varname} = 2;	# declared and in use
+	}
+	$obj = bless \$varname, $class;
+	return $obj;
+    }
+    sub DESTROY {
+	my $obj = shift;
+	$alloc{$$obj} = 1; # no longer in use but still declared
+    }
+}
+{
+    package B::Shadow;
+    #
+    # This class gives a standard API for a perl object to shadow a
+    # C variable and only generate reloads/write-backs when necessary.
+    #
+    # Use $obj->load($foo) instead of runtime("shadowed_c_var = foo").
+    # Use $obj->write_back whenever shadowed_c_var needs to be up to date.
+    # Use $obj->invalidate whenever an unknown function may have
+    # set shadow itself.
+
+    sub new {
+	my ($class, $write_back) = @_;
+	# Object fields are perl shadow variable, validity flag
+	# (for *C* variable) and callback sub for write_back
+	# (passed perl shadow variable as argument).
+	bless [undef, 1, $write_back], $class;
+    }
+    sub load {
+	my ($obj, $newval) = @_;
+	$obj->[1] = 0;		# C variable no longer valid
+	$obj->[0] = $newval;
+    }
+    sub write_back {
+	my $obj = shift;
+	if (!($obj->[1])) {
+	    $obj->[1] = 1;	# C variable will now be valid
+	    &{$obj->[2]}($obj->[0]);
+	}
+    }
+    sub invalidate { $_[0]->[1] = 0 } # force C variable to be invalid
+}
+my $curcop = new B::Shadow (sub {
+    my $opsym = shift->save;
+    runtime("PL_curcop = (COP*)$opsym;");
+});
+
+#
+# Context stack shadowing. Mimics stuff in pp_ctl.c, cop.h and so on.
+#
+sub dopoptoloop {
+    my $cxix = $#cxstack;
+    while ($cxix >= 0 && $cxstack[$cxix]->{type} != CXt_LOOP) {
+	$cxix--;
+    }
+    debug "dopoptoloop: returning $cxix" if $debug_cxstack;
+    return $cxix;
+}
+
+sub dopoptolabel {
+    my $label = shift;
+    my $cxix = $#cxstack;
+    while ($cxix >= 0 && $cxstack[$cxix]->{type} != CXt_LOOP
+	   && $cxstack[$cxix]->{label} ne $label) {
+	$cxix--;
+    }
+    debug "dopoptolabel: returning $cxix" if $debug_cxstack;
+    return $cxix;
+}
+
+sub error {
+    my $format = shift;
+    my $file = $curcop->[0]->filegv->SV->PV;
+    my $line = $curcop->[0]->line;
+    $errors++;
+    if (@_) {
+	warn sprintf("%s:%d: $format\n", $file, $line, @_);
+    } else {
+	warn sprintf("%s:%d: %s\n", $file, $line, $format);
+    }
+}
+
+#
+# Load pad takes (the elements of) a PADLIST as arguments and loads
+# up @pad with Stackobj-derived objects which represent those lexicals.
+# If/when perl itself can generate type information (my int $foo) then
+# we'll take advantage of that here. Until then, we'll use various hacks
+# to tell the compiler when we want a lexical to be a particular type
+# or to be a register.
+#
+sub load_pad {
+    my ($namelistav, $valuelistav) = @_;
+    @padlist = @_;
+    my @namelist = $namelistav->ARRAY;
+    my @valuelist = $valuelistav->ARRAY;
+    my $ix;
+    @pad = ();
+    debug "load_pad: $#namelist names, $#valuelist values\n" if $debug_pad;
+    # Temporary lexicals don't get named so it's possible for @valuelist
+    # to be strictly longer than @namelist. We count $ix up to the end of
+    # @valuelist but index into @namelist for the name. Any temporaries which
+    # run off the end of @namelist will make $namesv undefined and we treat
+    # that the same as having an explicit SPECIAL sv_undef object in @namelist.
+    # [XXX If/when @_ becomes a lexical, we must start at 0 here.]
+    for ($ix = 1; $ix < @valuelist; $ix++) {
+	my $namesv = $namelist[$ix];
+	my $type = T_UNKNOWN;
+	my $flags = 0;
+	my $name = "tmp$ix";
+	my $class = class($namesv);
+	if (!defined($namesv) || $class eq "SPECIAL") {
+	    # temporaries have &PL_sv_undef instead of a PVNV for a name
+	    $flags = VALID_SV|TEMPORARY|REGISTER;
+	} else {
+	    if ($namesv->PV =~ /^\$(.*)_([di])(r?)$/) {
+		$name = $1;
+		if ($2 eq "i") {
+		    $type = T_INT;
+		    $flags = VALID_SV|VALID_INT;
+		} elsif ($2 eq "d") {
+		    $type = T_DOUBLE;
+		    $flags = VALID_SV|VALID_DOUBLE;
+		}
+		$flags |= REGISTER if $3;
+	    }
+	}
+	$pad[$ix] = new B::Stackobj::Padsv ($type, $flags, $ix,
+					    "i_$name", "d_$name");
+	declare("IV", $type == T_INT ? "i_$name = 0" : "i_$name");
+	declare("double", $type == T_DOUBLE ? "d_$name = 0" : "d_$name");
+	debug sprintf("PL_curpad[$ix] = %s\n", $pad[$ix]->peek) if $debug_pad;
+    }
+}
+
+#
+# Debugging stuff
+#
+sub peek_stack { sprintf "stack = %s\n", join(" ", map($_->minipeek, @stack)) }
+
+#
+# OP stuff
+#
+
+sub label {
+    my $op = shift;
+    # XXX Preserve original label name for "real" labels?
+    return sprintf("lab_%x", $$op);
+}
+
+sub write_label {
+    my $op = shift;
+    push_runtime(sprintf("  %s:", label($op)));
+}
+
+sub loadop {
+    my $op = shift;
+    my $opsym = $op->save;
+    runtime("PL_op = $opsym;") unless $know_op;
+    return $opsym;
+}
+
+sub doop {
+    my $op = shift;
+    my $ppname = $op->ppaddr;
+    my $sym = loadop($op);
+    runtime("DOOP($ppname);");
+    $know_op = 1;
+    return $sym;
+}
+
+sub gimme {
+    my $op = shift;
+    my $flags = $op->flags;
+    return (($flags & OPf_KNOW) ? ($flags & OPf_LIST) : "dowantarray()");
+}
+
+#
+# Code generation for PP code
+#
+
+sub pp_null {
+    my $op = shift;
+    return $op->next;
+}
+
+sub pp_stub {
+    my $op = shift;
+    my $gimme = gimme($op);
+    if ($gimme != 1) {
+	# XXX Change to push a constant sv_undef Stackobj onto @stack
+	write_back_stack();
+	runtime("if ($gimme != G_ARRAY) XPUSHs(&PL_sv_undef);");
+    }
+    return $op->next;
+}
+
+sub pp_unstack {
+    my $op = shift;
+    @stack = ();
+    runtime("PP_UNSTACK;");
+    return $op->next;
+}
+
+sub pp_and {
+    my $op = shift;
+    my $next = $op->next;
+    reload_lexicals();
+    unshift(@bblock_todo, $next);
+    if (@stack >= 1) {
+	my $bool = pop_bool();
+	write_back_stack();
+	runtime(sprintf("if (!$bool) goto %s;", label($next)));
+    } else {
+	runtime(sprintf("if (!%s) goto %s;", top_bool(), label($next)),
+		"*sp--;");
+    }
+    return $op->other;
+}
+	    
+sub pp_or {
+    my $op = shift;
+    my $next = $op->next;
+    reload_lexicals();
+    unshift(@bblock_todo, $next);
+    if (@stack >= 1) {
+	my $obj = pop @stack;
+	write_back_stack();
+	runtime(sprintf("if (%s) { XPUSHs(%s); goto %s; }",
+			$obj->as_numeric, $obj->as_sv, label($next)));
+    } else {
+	runtime(sprintf("if (%s) goto %s;", top_bool(), label($next)),
+		"*sp--;");
+    }
+    return $op->other;
+}
+	    
+sub pp_cond_expr {
+    my $op = shift;
+    my $false = $op->false;
+    unshift(@bblock_todo, $false);
+    reload_lexicals();
+    my $bool = pop_bool();
+    write_back_stack();
+    runtime(sprintf("if (!$bool) goto %s;", label($false)));
+    return $op->true;
+}
+
+sub pp_padsv {
+    my $op = shift;
+    my $ix = $op->targ;
+    push(@stack, $pad[$ix]);
+    if ($op->flags & OPf_MOD) {
+	my $private = $op->private;
+	if ($private & OPpLVAL_INTRO) {
+	    runtime("SAVECLEARSV(PL_curpad[$ix]);");
+	} elsif ($private & OPpDEREF) {
+	    runtime(sprintf("vivify_ref(PL_curpad[%d], %d);",
+			    $ix, $private & OPpDEREF));
+	    $pad[$ix]->invalidate;
+	}
+    }
+    return $op->next;
+}
+
+sub pp_const {
+    my $op = shift;
+    my $sv = $op->sv;
+    my $obj = $constobj{$$sv};
+    if (!defined($obj)) {
+	$obj = $constobj{$$sv} = new B::Stackobj::Const ($sv);
+    }
+    push(@stack, $obj);
+    return $op->next;
+}
+
+sub pp_nextstate {
+    my $op = shift;
+    $curcop->load($op);
+    @stack = ();
+    debug(sprintf("%s:%d\n", $op->filegv->SV->PV, $op->line)) if $debug_lineno;
+    runtime("TAINT_NOT;") unless $omit_taint;
+    runtime("sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;");
+    if ($freetmps_each_bblock || $freetmps_each_loop) {
+	$need_freetmps = 1;
+    } else {
+	runtime("FREETMPS;");
+    }
+    return $op->next;
+}
+
+sub pp_dbstate {
+    my $op = shift;
+    $curcop->invalidate; # XXX?
+    return default_pp($op);
+}
+
+sub pp_rv2gv { $curcop->write_back; default_pp(@_) }
+sub pp_bless { $curcop->write_back; default_pp(@_) }
+sub pp_repeat { $curcop->write_back; default_pp(@_) }
+# The following subs need $curcop->write_back if we decide to support arybase:
+# pp_pos, pp_substr, pp_index, pp_rindex, pp_aslice, pp_lslice, pp_splice
+sub pp_sort { $curcop->write_back; default_pp(@_) }
+sub pp_caller { $curcop->write_back; default_pp(@_) }
+sub pp_reset { $curcop->write_back; default_pp(@_) }
+
+sub pp_gv {
+    my $op = shift;
+    my $gvsym = $op->gv->save;
+    write_back_stack();
+    runtime("XPUSHs((SV*)$gvsym);");
+    return $op->next;
+}
+
+sub pp_gvsv {
+    my $op = shift;
+    my $gvsym = $op->gv->save;
+    write_back_stack();
+    if ($op->private & OPpLVAL_INTRO) {
+	runtime("XPUSHs(save_scalar($gvsym));");
+    } else {
+	runtime("XPUSHs(GvSV($gvsym));");
+    }
+    return $op->next;
+}
+
+sub pp_aelemfast {
+    my $op = shift;
+    my $gvsym = $op->gv->save;
+    my $ix = $op->private;
+    my $flag = $op->flags & OPf_MOD;
+    write_back_stack();
+    runtime("svp = av_fetch(GvAV($gvsym), $ix, $flag);",
+	    "PUSHs(svp ? *svp : &PL_sv_undef);");
+    return $op->next;
+}
+
+sub int_binop {
+    my ($op, $operator) = @_;
+    if ($op->flags & OPf_STACKED) {
+	my $right = pop_int();
+	if (@stack >= 1) {
+	    my $left = top_int();
+	    $stack[-1]->set_int(&$operator($left, $right));
+	} else {
+	    runtime(sprintf("sv_setiv(TOPs, %s);",&$operator("TOPi", $right)));
+	}
+    } else {
+	my $targ = $pad[$op->targ];
+	my $right = new B::Pseudoreg ("IV", "riv");
+	my $left = new B::Pseudoreg ("IV", "liv");
+	runtime(sprintf("$$right = %s; $$left = %s;", pop_int(), pop_int));
+	$targ->set_int(&$operator($$left, $$right));
+	push(@stack, $targ);
+    }
+    return $op->next;
+}
+
+sub INTS_CLOSED () { 0x1 }
+sub INT_RESULT () { 0x2 }
+sub NUMERIC_RESULT () { 0x4 }
+
+sub numeric_binop {
+    my ($op, $operator, $flags) = @_;
+    my $force_int = 0;
+    $force_int ||= ($flags & INT_RESULT);
+    $force_int ||= ($flags & INTS_CLOSED && @stack >= 2
+		    && valid_int($stack[-2]) && valid_int($stack[-1]));
+    if ($op->flags & OPf_STACKED) {
+	my $right = pop_numeric();
+	if (@stack >= 1) {
+	    my $left = top_numeric();
+	    if ($force_int) {
+		$stack[-1]->set_int(&$operator($left, $right));
+	    } else {
+		$stack[-1]->set_numeric(&$operator($left, $right));
+	    }
+	} else {
+	    if ($force_int) {
+		runtime(sprintf("sv_setiv(TOPs, %s);",
+				&$operator("TOPi", $right)));
+	    } else {
+		runtime(sprintf("sv_setnv(TOPs, %s);",
+				&$operator("TOPn", $right)));
+	    }
+	}
+    } else {
+	my $targ = $pad[$op->targ];
+	$force_int ||= ($targ->{type} == T_INT);
+	if ($force_int) {
+	    my $right = new B::Pseudoreg ("IV", "riv");
+	    my $left = new B::Pseudoreg ("IV", "liv");
+	    runtime(sprintf("$$right = %s; $$left = %s;",
+			    pop_numeric(), pop_numeric));
+	    $targ->set_int(&$operator($$left, $$right));
+	} else {
+	    my $right = new B::Pseudoreg ("double", "rnv");
+	    my $left = new B::Pseudoreg ("double", "lnv");
+	    runtime(sprintf("$$right = %s; $$left = %s;",
+			    pop_numeric(), pop_numeric));
+	    $targ->set_numeric(&$operator($$left, $$right));
+	}
+	push(@stack, $targ);
+    }
+    return $op->next;
+}
+
+sub sv_binop {
+    my ($op, $operator, $flags) = @_;
+    if ($op->flags & OPf_STACKED) {
+	my $right = pop_sv();
+	if (@stack >= 1) {
+	    my $left = top_sv();
+	    if ($flags & INT_RESULT) {
+		$stack[-1]->set_int(&$operator($left, $right));
+	    } elsif ($flags & NUMERIC_RESULT) {
+		$stack[-1]->set_numeric(&$operator($left, $right));
+	    } else {
+		# XXX Does this work?
+		runtime(sprintf("sv_setsv($left, %s);",
+				&$operator($left, $right)));
+		$stack[-1]->invalidate;
+	    }
+	} else {
+	    my $f;
+	    if ($flags & INT_RESULT) {
+		$f = "sv_setiv";
+	    } elsif ($flags & NUMERIC_RESULT) {
+		$f = "sv_setnv";
+	    } else {
+		$f = "sv_setsv";
+	    }
+	    runtime(sprintf("%s(TOPs, %s);", $f, &$operator("TOPs", $right)));
+	}
+    } else {
+	my $targ = $pad[$op->targ];
+	runtime(sprintf("right = %s; left = %s;", pop_sv(), pop_sv));
+	if ($flags & INT_RESULT) {
+	    $targ->set_int(&$operator("left", "right"));
+	} elsif ($flags & NUMERIC_RESULT) {
+	    $targ->set_numeric(&$operator("left", "right"));
+	} else {
+	    # XXX Does this work?
+	    runtime(sprintf("sv_setsv(%s, %s);",
+			    $targ->as_sv, &$operator("left", "right")));
+	    $targ->invalidate;
+	}
+	push(@stack, $targ);
+    }
+    return $op->next;
+}
+    
+sub bool_int_binop {
+    my ($op, $operator) = @_;
+    my $right = new B::Pseudoreg ("IV", "riv");
+    my $left = new B::Pseudoreg ("IV", "liv");
+    runtime(sprintf("$$right = %s; $$left = %s;", pop_int(), pop_int()));
+    my $bool = new B::Stackobj::Bool (new B::Pseudoreg ("int", "b"));
+    $bool->set_int(&$operator($$left, $$right));
+    push(@stack, $bool);
+    return $op->next;
+}
+
+sub bool_numeric_binop {
+    my ($op, $operator) = @_;
+    my $right = new B::Pseudoreg ("double", "rnv");
+    my $left = new B::Pseudoreg ("double", "lnv");
+    runtime(sprintf("$$right = %s; $$left = %s;",
+		    pop_numeric(), pop_numeric()));
+    my $bool = new B::Stackobj::Bool (new B::Pseudoreg ("int", "b"));
+    $bool->set_numeric(&$operator($$left, $$right));
+    push(@stack, $bool);
+    return $op->next;
+}
+
+sub bool_sv_binop {
+    my ($op, $operator) = @_;
+    runtime(sprintf("right = %s; left = %s;", pop_sv(), pop_sv()));
+    my $bool = new B::Stackobj::Bool (new B::Pseudoreg ("int", "b"));
+    $bool->set_numeric(&$operator("left", "right"));
+    push(@stack, $bool);
+    return $op->next;
+}
+
+sub infix_op {
+    my $opname = shift;
+    return sub { "$_[0] $opname $_[1]" }
+}
+
+sub prefix_op {
+    my $opname = shift;
+    return sub { sprintf("%s(%s)", $opname, join(", ", @_)) }
+}
+
+BEGIN {
+    my $plus_op = infix_op("+");
+    my $minus_op = infix_op("-");
+    my $multiply_op = infix_op("*");
+    my $divide_op = infix_op("/");
+    my $modulo_op = infix_op("%");
+    my $lshift_op = infix_op("<<");
+    my $rshift_op = infix_op(">>");
+    my $ncmp_op = sub { "($_[0] > $_[1] ? 1 : ($_[0] < $_[1]) ? -1 : 0)" };
+    my $scmp_op = prefix_op("sv_cmp");
+    my $seq_op = prefix_op("sv_eq");
+    my $sne_op = prefix_op("!sv_eq");
+    my $slt_op = sub { "sv_cmp($_[0], $_[1]) < 0" };
+    my $sgt_op = sub { "sv_cmp($_[0], $_[1]) > 0" };
+    my $sle_op = sub { "sv_cmp($_[0], $_[1]) <= 0" };
+    my $sge_op = sub { "sv_cmp($_[0], $_[1]) >= 0" };
+    my $eq_op = infix_op("==");
+    my $ne_op = infix_op("!=");
+    my $lt_op = infix_op("<");
+    my $gt_op = infix_op(">");
+    my $le_op = infix_op("<=");
+    my $ge_op = infix_op(">=");
+
+    #
+    # XXX The standard perl PP code has extra handling for
+    # some special case arguments of these operators.
+    #
+    sub pp_add { numeric_binop($_[0], $plus_op, INTS_CLOSED) }
+    sub pp_subtract { numeric_binop($_[0], $minus_op, INTS_CLOSED) }
+    sub pp_multiply { numeric_binop($_[0], $multiply_op, INTS_CLOSED) }
+    sub pp_divide { numeric_binop($_[0], $divide_op) }
+    sub pp_modulo { int_binop($_[0], $modulo_op) } # differs from perl's
+    sub pp_ncmp { numeric_binop($_[0], $ncmp_op, INT_RESULT) }
+
+    sub pp_left_shift { int_binop($_[0], $lshift_op) }
+    sub pp_right_shift { int_binop($_[0], $rshift_op) }
+    sub pp_i_add { int_binop($_[0], $plus_op) }
+    sub pp_i_subtract { int_binop($_[0], $minus_op) }
+    sub pp_i_multiply { int_binop($_[0], $multiply_op) }
+    sub pp_i_divide { int_binop($_[0], $divide_op) }
+    sub pp_i_modulo { int_binop($_[0], $modulo_op) }
+
+    sub pp_eq { bool_numeric_binop($_[0], $eq_op) }
+    sub pp_ne { bool_numeric_binop($_[0], $ne_op) }
+    sub pp_lt { bool_numeric_binop($_[0], $lt_op) }
+    sub pp_gt { bool_numeric_binop($_[0], $gt_op) }
+    sub pp_le { bool_numeric_binop($_[0], $le_op) }
+    sub pp_ge { bool_numeric_binop($_[0], $ge_op) }
+
+    sub pp_i_eq { bool_int_binop($_[0], $eq_op) }
+    sub pp_i_ne { bool_int_binop($_[0], $ne_op) }
+    sub pp_i_lt { bool_int_binop($_[0], $lt_op) }
+    sub pp_i_gt { bool_int_binop($_[0], $gt_op) }
+    sub pp_i_le { bool_int_binop($_[0], $le_op) }
+    sub pp_i_ge { bool_int_binop($_[0], $ge_op) }
+
+    sub pp_scmp { sv_binop($_[0], $scmp_op, INT_RESULT) }
+    sub pp_slt { bool_sv_binop($_[0], $slt_op) }
+    sub pp_sgt { bool_sv_binop($_[0], $sgt_op) }
+    sub pp_sle { bool_sv_binop($_[0], $sle_op) }
+    sub pp_sge { bool_sv_binop($_[0], $sge_op) }
+    sub pp_seq { bool_sv_binop($_[0], $seq_op) }
+    sub pp_sne { bool_sv_binop($_[0], $sne_op) }
+}
+
+
+sub pp_sassign {
+    my $op = shift;
+    my $backwards = $op->private & OPpASSIGN_BACKWARDS;
+    my ($dst, $src);
+    if (@stack >= 2) {
+	$dst = pop @stack;
+	$src = pop @stack;
+	($src, $dst) = ($dst, $src) if $backwards;
+	my $type = $src->{type};
+	if ($type == T_INT) {
+	    $dst->set_int($src->as_int);
+	} elsif ($type == T_DOUBLE) {
+	    $dst->set_numeric($src->as_numeric);
+	} else {
+	    $dst->set_sv($src->as_sv);
+	}
+	push(@stack, $dst);
+    } elsif (@stack == 1) {
+	if ($backwards) {
+	    my $src = pop @stack;
+	    my $type = $src->{type};
+	    runtime("if (PL_tainting && PL_tainted) TAINT_NOT;");
+	    if ($type == T_INT) {
+		runtime sprintf("sv_setiv(TOPs, %s);", $src->as_int);
+	    } elsif ($type == T_DOUBLE) {
+		runtime sprintf("sv_setnv(TOPs, %s);", $src->as_double);
+	    } else {
+		runtime sprintf("sv_setsv(TOPs, %s);", $src->as_sv);
+	    }
+	    runtime("SvSETMAGIC(TOPs);");
+	} else {
+	    my $dst = pop @stack;
+	    my $type = $dst->{type};
+	    runtime("sv = POPs;");
+	    runtime("MAYBE_TAINT_SASSIGN_SRC(sv);");
+	    if ($type == T_INT) {
+		$dst->set_int("SvIV(sv)");
+	    } elsif ($type == T_DOUBLE) {
+		$dst->set_double("SvNV(sv)");
+	    } else {
+		runtime("SvSetSV($dst->{sv}, sv);");
+		$dst->invalidate;
+	    }
+	}
+    } else {
+	if ($backwards) {
+	    runtime("src = POPs; dst = TOPs;");
+	} else {
+	    runtime("dst = POPs; src = TOPs;");
+	}
+	runtime("MAYBE_TAINT_SASSIGN_SRC(src);",
+		"SvSetSV(dst, src);",
+		"SvSETMAGIC(dst);",
+		"SETs(dst);");
+    }
+    return $op->next;
+}
+
+sub pp_preinc {
+    my $op = shift;
+    if (@stack >= 1) {
+	my $obj = $stack[-1];
+	my $type = $obj->{type};
+	if ($type == T_INT || $type == T_DOUBLE) {
+	    $obj->set_int($obj->as_int . " + 1");
+	} else {
+	    runtime sprintf("PP_PREINC(%s);", $obj->as_sv);
+	    $obj->invalidate();
+	}
+    } else {
+	runtime sprintf("PP_PREINC(TOPs);");
+    }
+    return $op->next;
+}
+
+sub pp_pushmark {
+    my $op = shift;
+    write_back_stack();
+    runtime("PUSHMARK(sp);");
+    return $op->next;
+}
+
+sub pp_list {
+    my $op = shift;
+    write_back_stack();
+    my $gimme = gimme($op);
+    if ($gimme == 1) { # sic
+	runtime("POPMARK;"); # need this even though not a "full" pp_list
+    } else {
+	runtime("PP_LIST($gimme);");
+    }
+    return $op->next;
+}
+
+sub pp_entersub {
+    my $op = shift;
+    write_back_lexicals(REGISTER|TEMPORARY);
+    write_back_stack();
+    my $sym = doop($op);
+    runtime("if (PL_op != ($sym)->op_next) PL_op = (*PL_op->op_ppaddr)(ARGS);");
+    runtime("SPAGAIN;");
+    $know_op = 0;
+    invalidate_lexicals(REGISTER|TEMPORARY);
+    return $op->next;
+}
+
+sub pp_enterwrite {
+    my $op = shift;
+    pp_entersub($op);
+}
+
+sub pp_leavewrite {
+    my $op = shift;
+    write_back_lexicals(REGISTER|TEMPORARY);
+    write_back_stack();
+    my $sym = doop($op);
+    # XXX Is this the right way to distinguish between it returning
+    # CvSTART(cv) (via doform) and pop_return()?
+    runtime("if (PL_op) PL_op = (*PL_op->op_ppaddr)(ARGS);");
+    runtime("SPAGAIN;");
+    $know_op = 0;
+    invalidate_lexicals(REGISTER|TEMPORARY);
+    return $op->next;
+}
+
+sub doeval {
+    my $op = shift;
+    $curcop->write_back;
+    write_back_lexicals(REGISTER|TEMPORARY);
+    write_back_stack();
+    my $sym = loadop($op);
+    my $ppaddr = $op->ppaddr;
+    runtime("PP_EVAL($ppaddr, ($sym)->op_next);");
+    $know_op = 1;
+    invalidate_lexicals(REGISTER|TEMPORARY);
+    return $op->next;
+}
+
+sub pp_entereval { doeval(@_) }
+sub pp_require { doeval(@_) }
+sub pp_dofile { doeval(@_) }
+
+sub pp_entertry {
+    my $op = shift;
+    $curcop->write_back;
+    write_back_lexicals(REGISTER|TEMPORARY);
+    write_back_stack();
+    my $sym = doop($op);
+    my $jmpbuf = sprintf("jmpbuf%d", $jmpbuf_ix++);
+    declare("Sigjmp_buf", $jmpbuf);
+    runtime(sprintf("PP_ENTERTRY(%s,%s);", $jmpbuf, label($op->other->next)));
+    invalidate_lexicals(REGISTER|TEMPORARY);
+    return $op->next;
+}
+
+sub pp_grepstart {
+    my $op = shift;
+    if ($need_freetmps && $freetmps_each_loop) {
+	runtime("FREETMPS;"); # otherwise the grepwhile loop messes things up
+	$need_freetmps = 0;
+    }
+    write_back_stack();
+    doop($op);
+    return $op->next->other;
+}
+
+sub pp_mapstart {
+    my $op = shift;
+    if ($need_freetmps && $freetmps_each_loop) {
+	runtime("FREETMPS;"); # otherwise the mapwhile loop messes things up
+	$need_freetmps = 0;
+    }
+    write_back_stack();
+    doop($op);
+    return $op->next->other;
+}
+
+sub pp_grepwhile {
+    my $op = shift;
+    my $next = $op->next;
+    unshift(@bblock_todo, $next);
+    write_back_lexicals();
+    write_back_stack();
+    my $sym = doop($op);
+    # pp_grepwhile can return either op_next or op_other and we need to
+    # be able to distinguish the two at runtime. Since it's possible for
+    # both ops to be "inlined", the fields could both be zero. To get
+    # around that, we hack op_next to be our own op (purely because we
+    # know it's a non-NULL pointer and can't be the same as op_other).
+    $init->add("((LOGOP*)$sym)->op_next = $sym;");
+    runtime(sprintf("if (PL_op == ($sym)->op_next) goto %s;", label($next)));
+    $know_op = 0;
+    return $op->other;
+}
+
+sub pp_mapwhile {
+    pp_grepwhile(@_);
+}
+
+sub pp_return {
+    my $op = shift;
+    write_back_lexicals(REGISTER|TEMPORARY);
+    write_back_stack();
+    doop($op);
+    runtime("PUTBACK;", "return 0;");
+    $know_op = 0;
+    return $op->next;
+}
+
+sub nyi {
+    my $op = shift;
+    warn sprintf("%s not yet implemented properly\n", $op->ppaddr);
+    return default_pp($op);
+}
+
+sub pp_range {
+    my $op = shift;
+    my $flags = $op->flags;
+    if (!($flags & OPf_KNOW)) {
+	error("context of range unknown at compile-time");
+    }
+    write_back_lexicals();
+    write_back_stack();
+    if (!($flags & OPf_LIST)) {
+	# We need to save our UNOP structure since pp_flop uses
+	# it to find and adjust out targ. We don't need it ourselves.
+	$op->save;
+	runtime sprintf("if (SvTRUE(PL_curpad[%d])) goto %s;",
+			$op->targ, label($op->false));
+	unshift(@bblock_todo, $op->false);
+    }
+    return $op->true;
+}
+
+sub pp_flip {
+    my $op = shift;
+    my $flags = $op->flags;
+    if (!($flags & OPf_KNOW)) {
+	error("context of flip unknown at compile-time");
+    }
+    if ($flags & OPf_LIST) {
+	return $op->first->false;
+    }
+    write_back_lexicals();
+    write_back_stack();
+    # We need to save our UNOP structure since pp_flop uses
+    # it to find and adjust out targ. We don't need it ourselves.
+    $op->save;
+    my $ix = $op->targ;
+    my $rangeix = $op->first->targ;
+    runtime(($op->private & OPpFLIP_LINENUM) ?
+	    "if (PL_last_in_gv && SvIV(TOPs) == IoLINES(GvIOp(PL_last_in_gv))) {"
+	  : "if (SvTRUE(TOPs)) {");
+    runtime("\tsv_setiv(PL_curpad[$rangeix], 1);");
+    if ($op->flags & OPf_SPECIAL) {
+	runtime("sv_setiv(PL_curpad[$ix], 1);");
+    } else {
+	runtime("\tsv_setiv(PL_curpad[$ix], 0);",
+		"\tsp--;",
+		sprintf("\tgoto %s;", label($op->first->false)));
+    }
+    runtime("}",
+	  qq{sv_setpv(PL_curpad[$ix], "");},
+	    "SETs(PL_curpad[$ix]);");
+    $know_op = 0;
+    return $op->next;
+}
+
+sub pp_flop {
+    my $op = shift;
+    default_pp($op);
+    $know_op = 0;
+    return $op->next;
+}
+
+sub enterloop {
+    my $op = shift;
+    my $nextop = $op->nextop;
+    my $lastop = $op->lastop;
+    my $redoop = $op->redoop;
+    $curcop->write_back;
+    debug "enterloop: pushing on cxstack" if $debug_cxstack;
+    push(@cxstack, {
+	type => CXt_LOOP,
+	op => $op,
+	"label" => $curcop->[0]->label,
+	nextop => $nextop,
+	lastop => $lastop,
+	redoop => $redoop
+    });
+    $nextop->save;
+    $lastop->save;
+    $redoop->save;
+    return default_pp($op);
+}
+
+sub pp_enterloop { enterloop(@_) }
+sub pp_enteriter { enterloop(@_) }
+
+sub pp_leaveloop {
+    my $op = shift;
+    if (!@cxstack) {
+	die "panic: leaveloop";
+    }
+    debug "leaveloop: popping from cxstack" if $debug_cxstack;
+    pop(@cxstack);
+    return default_pp($op);
+}
+
+sub pp_next {
+    my $op = shift;
+    my $cxix;
+    if ($op->flags & OPf_SPECIAL) {
+	$cxix = dopoptoloop();
+	if ($cxix < 0) {
+	    error('"next" used outside loop');
+	    return $op->next; # ignore the op
+	}
+    } else {
+	$cxix = dopoptolabel($op->pv);
+	if ($cxix < 0) {
+	    error('Label not found at compile time for "next %s"', $op->pv);
+	    return $op->next; # ignore the op
+	}
+    }
+    default_pp($op);
+    my $nextop = $cxstack[$cxix]->{nextop};
+    push(@bblock_todo, $nextop);
+    runtime(sprintf("goto %s;", label($nextop)));
+    return $op->next;
+}
+
+sub pp_redo {
+    my $op = shift;
+    my $cxix;
+    if ($op->flags & OPf_SPECIAL) {
+	$cxix = dopoptoloop();
+	if ($cxix < 0) {
+	    error('"redo" used outside loop');
+	    return $op->next; # ignore the op
+	}
+    } else {
+	$cxix = dopoptolabel($op->pv);
+	if ($cxix < 0) {
+	    error('Label not found at compile time for "redo %s"', $op->pv);
+	    return $op->next; # ignore the op
+	}
+    }
+    default_pp($op);
+    my $redoop = $cxstack[$cxix]->{redoop};
+    push(@bblock_todo, $redoop);
+    runtime(sprintf("goto %s;", label($redoop)));
+    return $op->next;
+}
+
+sub pp_last {
+    my $op = shift;
+    my $cxix;
+    if ($op->flags & OPf_SPECIAL) {
+	$cxix = dopoptoloop();
+	if ($cxix < 0) {
+	    error('"last" used outside loop');
+	    return $op->next; # ignore the op
+	}
+    } else {
+	$cxix = dopoptolabel($op->pv);
+	if ($cxix < 0) {
+	    error('Label not found at compile time for "last %s"', $op->pv);
+	    return $op->next; # ignore the op
+	}
+	# XXX Add support for "last" to leave non-loop blocks
+	if ($cxstack[$cxix]->{type} != CXt_LOOP) {
+	    error('Use of "last" for non-loop blocks is not yet implemented');
+	    return $op->next; # ignore the op
+	}
+    }
+    default_pp($op);
+    my $lastop = $cxstack[$cxix]->{lastop}->next;
+    push(@bblock_todo, $lastop);
+    runtime(sprintf("goto %s;", label($lastop)));
+    return $op->next;
+}
+
+sub pp_subst {
+    my $op = shift;
+    write_back_lexicals();
+    write_back_stack();
+    my $sym = doop($op);
+    my $replroot = $op->pmreplroot;
+    if ($$replroot) {
+	runtime sprintf("if (PL_op == ((PMOP*)(%s))->op_pmreplroot) goto %s;",
+			$sym, label($replroot));
+	$op->pmreplstart->save;
+	push(@bblock_todo, $replroot);
+    }
+    invalidate_lexicals();
+    return $op->next;
+}
+
+sub pp_substcont {
+    my $op = shift;
+    write_back_lexicals();
+    write_back_stack();
+    doop($op);
+    my $pmop = $op->other;
+    warn sprintf("substcont: op = %s, pmop = %s\n",
+		 peekop($op), peekop($pmop));#debug
+#    my $pmopsym = objsym($pmop);
+    my $pmopsym = $pmop->save; # XXX can this recurse?
+    warn "pmopsym = $pmopsym\n";#debug
+    runtime sprintf("if (PL_op == ((PMOP*)(%s))->op_pmreplstart) goto %s;",
+		    $pmopsym, label($pmop->pmreplstart));
+    invalidate_lexicals();
+    return $pmop->next;
+}
+
+sub default_pp {
+    my $op = shift;
+    my $ppname = $op->ppaddr;
+    write_back_lexicals() unless $skip_lexicals{$ppname};
+    write_back_stack() unless $skip_stack{$ppname};
+    doop($op);
+    # XXX If the only way that ops can write to a TEMPORARY lexical is
+    # when it's named in $op->targ then we could call
+    # invalidate_lexicals(TEMPORARY) and avoid having to write back all
+    # the temporaries. For now, we'll play it safe and write back the lot.
+    invalidate_lexicals() unless $skip_invalidate{$ppname};
+    return $op->next;
+}
+
+sub compile_op {
+    my $op = shift;
+    my $ppname = $op->ppaddr;
+    if (exists $ignore_op{$ppname}) {
+	return $op->next;
+    }
+    debug peek_stack() if $debug_stack;
+    if ($debug_op) {
+	debug sprintf("%s [%s]\n",
+		     peekop($op),
+		     $op->flags & OPf_STACKED ? "OPf_STACKED" : $op->targ);
+    }
+    no strict 'refs';
+    if (defined(&$ppname)) {
+	$know_op = 0;
+	return &$ppname($op);
+    } else {
+	return default_pp($op);
+    }
+}
+
+sub compile_bblock {
+    my $op = shift;
+    #warn "compile_bblock: ", peekop($op), "\n"; # debug
+    write_label($op);
+    $know_op = 0;
+    do {
+	$op = compile_op($op);
+    } while (defined($op) && $$op && !exists($leaders->{$$op}));
+    write_back_stack(); # boo hoo: big loss
+    reload_lexicals();
+    return $op;
+}
+
+sub cc {
+    my ($name, $root, $start, @padlist) = @_;
+    my $op;
+    init_pp($name);
+    load_pad(@padlist);
+    B::Pseudoreg->new_scope;
+    @cxstack = ();
+    if ($debug_timings) {
+	warn sprintf("Basic block analysis at %s\n", timing_info);
+    }
+    $leaders = find_leaders($root, $start);
+    @bblock_todo = ($start, values %$leaders);
+    if ($debug_timings) {
+	warn sprintf("Compilation at %s\n", timing_info);
+    }
+    while (@bblock_todo) {
+	$op = shift @bblock_todo;
+	#warn sprintf("Considering basic block %s\n", peekop($op)); # debug
+	next if !defined($op) || !$$op || $done{$$op};
+	#warn "...compiling it\n"; # debug
+	do {
+	    $done{$$op} = 1;
+	    $op = compile_bblock($op);
+	    if ($need_freetmps && $freetmps_each_bblock) {
+		runtime("FREETMPS;");
+		$need_freetmps = 0;
+	    }
+	} while defined($op) && $$op && !$done{$$op};
+	if ($need_freetmps && $freetmps_each_loop) {
+	    runtime("FREETMPS;");
+	    $need_freetmps = 0;
+	}
+	if (!$$op) {
+	    runtime("PUTBACK;", "return 0;");
+	} elsif ($done{$$op}) {
+	    runtime(sprintf("goto %s;", label($op)));
+	}
+    }
+    if ($debug_timings) {
+	warn sprintf("Saving runtime at %s\n", timing_info);
+    }
+    save_runtime();
+}
+
+sub cc_recurse {
+    my $ccinfo;
+    my $start;
+    $start = cc_queue(@_) if @_;
+    while ($ccinfo = shift @cc_todo) {
+	cc(@$ccinfo);
+    }
+    return $start;
+}    
+
+sub cc_obj {
+    my ($name, $cvref) = @_;
+    my $cv = svref_2object($cvref);
+    my @padlist = $cv->PADLIST->ARRAY;
+    my $curpad_sym = $padlist[1]->save;
+    cc_recurse($name, $cv->ROOT, $cv->START, @padlist);
+}
+
+sub cc_main {
+    my @comppadlist = comppadlist->ARRAY;
+    my $curpad_sym = $comppadlist[1]->save;
+    my $start = cc_recurse("pp_main", main_root, main_start, @comppadlist);
+    save_unused_subs(@unused_sub_packages);
+    cc_recurse();
+
+    return if $errors;
+    if (!defined($module)) {
+	$init->add(sprintf("PL_main_root = s\\_%x;", ${main_root()}),
+		   "PL_main_start = $start;",
+		   "PL_curpad = AvARRAY($curpad_sym);");
+    }
+    output_boilerplate();
+    print "\n";
+    output_all("perl_init");
+    output_runtime();
+    print "\n";
+    output_main();
+    if (defined($module)) {
+	my $cmodule = $module;
+	$cmodule =~ s/::/__/g;
+	print <<"EOT";
+
+#include "XSUB.h"
+XS(boot_$cmodule)
+{
+    dXSARGS;
+    perl_init();
+    ENTER;
+    SAVETMPS;
+    SAVESPTR(PL_curpad);
+    SAVESPTR(PL_op);
+    PL_curpad = AvARRAY($curpad_sym);
+    PL_op = $start;
+    pp_main(ARGS);
+    FREETMPS;
+    LEAVE;
+    ST(0) = &PL_sv_yes;
+    XSRETURN(1);
+}
+EOT
+    }
+    if ($debug_timings) {
+	warn sprintf("Done at %s\n", timing_info);
+    }
+}
+
+sub compile {
+    my @options = @_;
+    my ($option, $opt, $arg);
+  OPTION:
+    while ($option = shift @options) {
+	if ($option =~ /^-(.)(.*)/) {
+	    $opt = $1;
+	    $arg = $2;
+	} else {
+	    unshift @options, $option;
+	    last OPTION;
+	}
+	if ($opt eq "-" && $arg eq "-") {
+	    shift @options;
+	    last OPTION;
+	} elsif ($opt eq "o") {
+	    $arg ||= shift @options;
+	    open(STDOUT, ">$arg") or return "open '>$arg': $!\n";
+	} elsif ($opt eq "n") {
+	    $arg ||= shift @options;
+	    $module_name = $arg;
+	} elsif ($opt eq "u") {
+	    $arg ||= shift @options;
+	    push(@unused_sub_packages, $arg);
+	} elsif ($opt eq "f") {
+	    $arg ||= shift @options;
+	    my $value = $arg !~ s/^no-//;
+	    $arg =~ s/-/_/g;
+	    my $ref = $optimise{$arg};
+	    if (defined($ref)) {
+		$$ref = $value;
+	    } else {
+		warn qq(ignoring unknown optimisation option "$arg"\n);
+	    }
+	} elsif ($opt eq "O") {
+	    $arg = 1 if $arg eq "";
+	    my $ref;
+	    foreach $ref (values %optimise) {
+		$$ref = 0;
+	    }
+	    if ($arg >= 2) {
+		$freetmps_each_loop = 1;
+	    }
+	    if ($arg >= 1) {
+		$freetmps_each_bblock = 1 unless $freetmps_each_loop;
+	    }
+	} elsif ($opt eq "m") {
+	    $arg ||= shift @options;
+	    $module = $arg;
+	    push(@unused_sub_packages, $arg);
+	} elsif ($opt eq "p") {
+	    $arg ||= shift @options;
+	    $patchlevel = $arg;
+	} elsif ($opt eq "D") {
+            $arg ||= shift @options;
+	    foreach $arg (split(//, $arg)) {
+		if ($arg eq "o") {
+		    B->debug(1);
+		} elsif ($arg eq "O") {
+		    $debug_op = 1;
+		} elsif ($arg eq "s") {
+		    $debug_stack = 1;
+		} elsif ($arg eq "c") {
+		    $debug_cxstack = 1;
+		} elsif ($arg eq "p") {
+		    $debug_pad = 1;
+		} elsif ($arg eq "r") {
+		    $debug_runtime = 1;
+		} elsif ($arg eq "S") {
+		    $debug_shadow = 1;
+		} elsif ($arg eq "q") {
+		    $debug_queue = 1;
+		} elsif ($arg eq "l") {
+		    $debug_lineno = 1;
+		} elsif ($arg eq "t") {
+		    $debug_timings = 1;
+		}
+	    }
+	}
+    }
+    init_sections();
+    $init = B::Section->get("init");
+    $decl = B::Section->get("decl");
+
+    if (@options) {
+	return sub {
+	    my ($objname, $ppname);
+	    foreach $objname (@options) {
+		$objname = "main::$objname" unless $objname =~ /::/;
+		($ppname = $objname) =~ s/^.*?:://;
+		eval "cc_obj(qq(pp_sub_$ppname), \\&$objname)";
+		die "cc_obj(qq(pp_sub_$ppname, \\&$objname) failed: $@" if $@;
+		return if $errors;
+	    }
+	    output_boilerplate();
+	    print "\n";
+	    output_all($module_name || "init_module");
+	    output_runtime();
+	}
+    } else {
+	return sub { cc_main() };
+    }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+B::CC - Perl compiler's optimized C translation backend
+
+=head1 SYNOPSIS
+
+	perl -MO=CC[,OPTIONS] foo.pl
+
+=head1 DESCRIPTION
+
+This compiler backend takes Perl source and generates C source code
+corresponding to the flow of your program. In other words, this
+backend is somewhat a "real" compiler in the sense that many people
+think about compilers. Note however that, currently, it is a very
+poor compiler in that although it generates (mostly, or at least
+sometimes) correct code, it performs relatively few optimisations.
+This will change as the compiler develops. The result is that
+running an executable compiled with this backend may start up more
+quickly than running the original Perl program (a feature shared
+by the B<C> compiler backend--see F<B::C>) and may also execute
+slightly faster. This is by no means a good optimising compiler--yet.
+
+=head1 OPTIONS
+
+If there are any non-option arguments, they are taken to be
+names of objects to be saved (probably doesn't work properly yet).
+Without extra arguments, it saves the main program.
+
+=over 4
+
+=item B<-ofilename>
+
+Output to filename instead of STDOUT
+
+=item B<-v>
+
+Verbose compilation (currently gives a few compilation statistics).
+
+=item B<-->
+
+Force end of options
+
+=item B<-uPackname>
+
+Force apparently unused subs from package Packname to be compiled.
+This allows programs to use eval "foo()" even when sub foo is never
+seen to be used at compile time. The down side is that any subs which
+really are never used also have code generated. This option is
+necessary, for example, if you have a signal handler foo which you
+initialise with C<$SIG{BAR} = "foo">.  A better fix, though, is just
+to change it to C<$SIG{BAR} = \&foo>. You can have multiple B<-u>
+options. The compiler tries to figure out which packages may possibly
+have subs in which need compiling but the current version doesn't do
+it very well. In particular, it is confused by nested packages (i.e.
+of the form C<A::B>) where package C<A> does not contain any subs.
+
+=item B<-mModulename>
+
+Instead of generating source for a runnable executable, generate
+source for an XSUB module. The boot_Modulename function (which
+DynaLoader can look for) does the appropriate initialisation and runs
+the main part of the Perl source that is being compiled.
+
+
+=item B<-D>
+
+Debug options (concatenated or separate flags like C<perl -D>).
+
+=item B<-Dr>
+
+Writes debugging output to STDERR just as it's about to write to the
+program's runtime (otherwise writes debugging info as comments in
+its C output).
+
+=item B<-DO>
+
+Outputs each OP as it's compiled
+
+=item B<-Ds>
+
+Outputs the contents of the shadow stack at each OP
+
+=item B<-Dp>
+
+Outputs the contents of the shadow pad of lexicals as it's loaded for
+each sub or the main program.
+
+=item B<-Dq>
+
+Outputs the name of each fake PP function in the queue as it's about
+to process it.
+
+=item B<-Dl>
+
+Output the filename and line number of each original line of Perl
+code as it's processed (C<pp_nextstate>).
+
+=item B<-Dt>
+
+Outputs timing information of compilation stages.
+
+=item B<-f>
+
+Force optimisations on or off one at a time.
+
+=item B<-ffreetmps-each-bblock>
+
+Delays FREETMPS from the end of each statement to the end of the each
+basic block.
+
+=item B<-ffreetmps-each-loop>
+
+Delays FREETMPS from the end of each statement to the end of the group
+of basic blocks forming a loop. At most one of the freetmps-each-*
+options can be used.
+
+=item B<-fomit-taint>
+
+Omits generating code for handling perl's tainting mechanism.
+
+=item B<-On>
+
+Optimisation level (n = 0, 1, 2, ...). B<-O> means B<-O1>.
+Currently, B<-O1> sets B<-ffreetmps-each-bblock> and B<-O2>
+sets B<-ffreetmps-each-loop>.
+
+=back
+
+=head1 EXAMPLES
+
+        perl -MO=CC,-O2,-ofoo.c foo.pl
+        perl cc_harness -o foo foo.c
+
+Note that C<cc_harness> lives in the C<B> subdirectory of your perl
+library directory. The utility called C<perlcc> may also be used to
+help make use of this compiler.
+
+        perl -MO=CC,-mFoo,-oFoo.c Foo.pm
+        perl cc_harness -shared -c -o Foo.so Foo.c
+
+=head1 BUGS
+
+Plenty. Current status: experimental.
+
+=head1 DIFFERENCES
+
+These aren't really bugs but they are constructs which are heavily
+tied to perl's compile-and-go implementation and with which this
+compiler backend cannot cope.
+
+=head2 Loops
+
+Standard perl calculates the target of "next", "last", and "redo"
+at run-time. The compiler calculates the targets at compile-time.
+For example, the program
+
+    sub skip_on_odd { next NUMBER if $_[0] % 2 }
+    NUMBER: for ($i = 0; $i < 5; $i++) {
+        skip_on_odd($i);
+        print $i;
+    }
+
+produces the output
+
+    024
+
+with standard perl but gives a compile-time error with the compiler.
+
+=head2 Context of ".."
+
+The context (scalar or array) of the ".." operator determines whether
+it behaves as a range or a flip/flop. Standard perl delays until
+runtime the decision of which context it is in but the compiler needs
+to know the context at compile-time. For example,
+
+    @a = (4,6,1,0,0,1);
+    sub range { (shift @a)..(shift @a) }
+    print range();
+    while (@a) { print scalar(range()) }
+
+generates the output
+
+    456123E0
+
+with standard Perl but gives a compile-time error with compiled Perl.
+
+=head2 Arithmetic
+
+Compiled Perl programs use native C arithemtic much more frequently
+than standard perl. Operations on large numbers or on boundary
+cases may produce different behaviour.
+
+=head2 Deprecated features
+
+Features of standard perl such as C<$[> which have been deprecated
+in standard perl since Perl5 was released have not been implemented
+in the compiler.
+
+=head1 AUTHOR
+
+Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
+
+=cut
diff --git a/contrib/perl5/ext/B/B/Debug.pm b/contrib/perl5/ext/B/B/Debug.pm
new file mode 100644
index 0000000..7754a5a
--- /dev/null
+++ b/contrib/perl5/ext/B/B/Debug.pm
@@ -0,0 +1,283 @@
+package B::Debug;
+use strict;
+use B qw(peekop class walkoptree walkoptree_exec
+         main_start main_root cstring sv_undef);
+use B::Asmdata qw(@specialsv_name);
+
+my %done_gv;
+
+sub B::OP::debug {
+    my ($op) = @_;
+    printf <<'EOT', class($op), $$op, ${$op->next}, ${$op->sibling}, $op->ppaddr, $op->targ, $op->type, $op->seq, $op->flags, $op->private;
+%s (0x%lx)
+	op_next		0x%x
+	op_sibling	0x%x
+	op_ppaddr	%s
+	op_targ		%d
+	op_type		%d
+	op_seq		%d
+	op_flags	%d
+	op_private	%d
+EOT
+}
+
+sub B::UNOP::debug {
+    my ($op) = @_;
+    $op->B::OP::debug();
+    printf "\top_first\t0x%x\n", ${$op->first};
+}
+
+sub B::BINOP::debug {
+    my ($op) = @_;
+    $op->B::UNOP::debug();
+    printf "\top_last\t\t0x%x\n", ${$op->last};
+}
+
+sub B::LOGOP::debug {
+    my ($op) = @_;
+    $op->B::UNOP::debug();
+    printf "\top_other\t0x%x\n", ${$op->other};
+}
+
+sub B::CONDOP::debug {
+    my ($op) = @_;
+    $op->B::UNOP::debug();
+    printf "\top_true\t0x%x\n", ${$op->true};
+    printf "\top_false\t0x%x\n", ${$op->false};
+}
+
+sub B::LISTOP::debug {
+    my ($op) = @_;
+    $op->B::BINOP::debug();
+    printf "\top_children\t%d\n", $op->children;
+}
+
+sub B::PMOP::debug {
+    my ($op) = @_;
+    $op->B::LISTOP::debug();
+    printf "\top_pmreplroot\t0x%x\n", ${$op->pmreplroot};
+    printf "\top_pmreplstart\t0x%x\n", ${$op->pmreplstart};
+    printf "\top_pmnext\t0x%x\n", ${$op->pmnext};
+    printf "\top_pmregexp->precomp\t%s\n", cstring($op->precomp);
+    printf "\top_pmflags\t0x%x\n", $op->pmflags;
+    $op->pmshort->debug;
+    $op->pmreplroot->debug;
+}
+
+sub B::COP::debug {
+    my ($op) = @_;
+    $op->B::OP::debug();
+    my ($filegv) = $op->filegv;
+    printf <<'EOT', $op->label, ${$op->stash}, $$filegv, $op->seq, $op->arybase, $op->line;
+	cop_label	%s
+	cop_stash	0x%x
+	cop_filegv	0x%x
+	cop_seq		%d
+	cop_arybase	%d
+	cop_line	%d
+EOT
+    $filegv->debug;
+}
+
+sub B::SVOP::debug {
+    my ($op) = @_;
+    $op->B::OP::debug();
+    printf "\top_sv\t\t0x%x\n", ${$op->sv};
+    $op->sv->debug;
+}
+
+sub B::PVOP::debug {
+    my ($op) = @_;
+    $op->B::OP::debug();
+    printf "\top_pv\t\t0x%x\n", $op->pv;
+}
+
+sub B::GVOP::debug {
+    my ($op) = @_;
+    $op->B::OP::debug();
+    printf "\top_gv\t\t0x%x\n", ${$op->gv};
+    $op->gv->debug;
+}
+
+sub B::CVOP::debug {
+    my ($op) = @_;
+    $op->B::OP::debug();
+    printf "\top_cv\t\t0x%x\n", ${$op->cv};
+}
+
+sub B::NULL::debug {
+    my ($sv) = @_;
+    if ($$sv == ${sv_undef()}) {
+	print "&sv_undef\n";
+    } else {
+	printf "NULL (0x%x)\n", $$sv;
+    }
+}
+
+sub B::SV::debug {
+    my ($sv) = @_;
+    if (!$$sv) {
+	print class($sv), " = NULL\n";
+	return;
+    }
+    printf <<'EOT', class($sv), $$sv, $sv->REFCNT, $sv->FLAGS;
+%s (0x%x)
+	REFCNT		%d
+	FLAGS		0x%x
+EOT
+}
+
+sub B::PV::debug {
+    my ($sv) = @_;
+    $sv->B::SV::debug();
+    my $pv = $sv->PV();
+    printf <<'EOT', cstring($pv), length($pv);
+	xpv_pv		%s
+	xpv_cur		%d
+EOT
+}
+
+sub B::IV::debug {
+    my ($sv) = @_;
+    $sv->B::SV::debug();
+    printf "\txiv_iv\t\t%d\n", $sv->IV;
+}
+
+sub B::NV::debug {
+    my ($sv) = @_;
+    $sv->B::IV::debug();
+    printf "\txnv_nv\t\t%s\n", $sv->NV;
+}
+
+sub B::PVIV::debug {
+    my ($sv) = @_;
+    $sv->B::PV::debug();
+    printf "\txiv_iv\t\t%d\n", $sv->IV;
+}
+
+sub B::PVNV::debug {
+    my ($sv) = @_;
+    $sv->B::PVIV::debug();
+    printf "\txnv_nv\t\t%s\n", $sv->NV;
+}
+
+sub B::PVLV::debug {
+    my ($sv) = @_;
+    $sv->B::PVNV::debug();
+    printf "\txlv_targoff\t%d\n", $sv->TARGOFF;
+    printf "\txlv_targlen\t%u\n", $sv->TARGLEN;
+    printf "\txlv_type\t%s\n", cstring(chr($sv->TYPE));
+}
+
+sub B::BM::debug {
+    my ($sv) = @_;
+    $sv->B::PVNV::debug();
+    printf "\txbm_useful\t%d\n", $sv->USEFUL;
+    printf "\txbm_previous\t%u\n", $sv->PREVIOUS;
+    printf "\txbm_rare\t%s\n", cstring(chr($sv->RARE));
+}
+
+sub B::CV::debug {
+    my ($sv) = @_;
+    $sv->B::PVNV::debug();
+    my ($stash) = $sv->STASH;
+    my ($start) = $sv->START;
+    my ($root) = $sv->ROOT;
+    my ($padlist) = $sv->PADLIST;
+    my ($gv) = $sv->GV;
+    my ($filegv) = $sv->FILEGV;
+    printf <<'EOT', $$stash, $$start, $$root, $$gv, $$filegv, $sv->DEPTH, $padlist, ${$sv->OUTSIDE};
+	STASH		0x%x
+	START		0x%x
+	ROOT		0x%x
+	GV		0x%x
+	FILEGV		0x%x
+	DEPTH		%d
+	PADLIST		0x%x			       
+	OUTSIDE		0x%x
+EOT
+    $start->debug if $start;
+    $root->debug if $root;
+    $gv->debug if $gv;
+    $filegv->debug if $filegv;
+    $padlist->debug if $padlist;
+}
+
+sub B::AV::debug {
+    my ($av) = @_;
+    $av->B::SV::debug;
+    my(@array) = $av->ARRAY;
+    print "\tARRAY\t\t(", join(", ", map("0x" . $$_, @array)), ")\n";
+    printf <<'EOT', scalar(@array), $av->MAX, $av->OFF, $av->AvFLAGS;
+	FILL		%d    
+	MAX		%d
+	OFF		%d
+	AvFLAGS		%d
+EOT
+}
+    
+sub B::GV::debug {
+    my ($gv) = @_;
+    if ($done_gv{$$gv}++) {
+	printf "GV %s::%s\n", $gv->STASH->NAME, $gv->NAME;
+	return;
+    }
+    my ($sv) = $gv->SV;
+    my ($av) = $gv->AV;
+    my ($cv) = $gv->CV;
+    $gv->B::SV::debug;
+    printf <<'EOT', $gv->NAME, $gv->STASH->NAME, $gv->STASH, $$sv, $gv->GvREFCNT, $gv->FORM, $$av, ${$gv->HV}, ${$gv->EGV}, $$cv, $gv->CVGEN, $gv->LINE, $gv->FILEGV, $gv->GvFLAGS;
+	NAME		%s
+	STASH		%s (0x%x)
+	SV		0x%x
+	GvREFCNT	%d
+	FORM		0x%x
+	AV		0x%x
+	HV		0x%x
+	EGV		0x%x
+	CV		0x%x
+	CVGEN		%d
+	LINE		%d
+	FILEGV		0x%x
+	GvFLAGS		0x%x
+EOT
+    $sv->debug if $sv;
+    $av->debug if $av;
+    $cv->debug if $cv;
+}
+
+sub B::SPECIAL::debug {
+    my $sv = shift;
+    print $specialsv_name[$$sv], "\n";
+}
+
+sub compile {
+    my $order = shift;
+    if ($order eq "exec") {
+        return sub { walkoptree_exec(main_start, "debug") }
+    } else {
+        return sub { walkoptree(main_root, "debug") }
+    }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+B::Debug - Walk Perl syntax tree, printing debug info about ops
+
+=head1 SYNOPSIS
+
+	perl -MO=Debug[,OPTIONS] foo.pl
+
+=head1 DESCRIPTION
+
+See F<ext/B/README>.
+
+=head1 AUTHOR
+
+Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
+
+=cut
diff --git a/contrib/perl5/ext/B/B/Deparse.pm b/contrib/perl5/ext/B/B/Deparse.pm
new file mode 100644
index 0000000..5e0bd1d
--- /dev/null
+++ b/contrib/perl5/ext/B/B/Deparse.pm
@@ -0,0 +1,2670 @@
+# B::Deparse.pm
+# Copyright (c) 1998 Stephen McCamant. All rights reserved.
+# This module is free software; you can redistribute and/or modify
+# it under the same terms as Perl itself.
+
+# This is based on the module of the same name by Malcolm Beattie,
+# but essentially none of his code remains.
+
+package B::Deparse;
+use Carp 'cluck';
+use B qw(class main_root main_start main_cv svref_2object);
+$VERSION = 0.56;
+use strict;
+
+# Changes between 0.50 and 0.51:
+# - fixed nulled leave with live enter in sort { }
+# - fixed reference constants (\"str")
+# - handle empty programs gracefully
+# - handle infinte loops (for (;;) {}, while (1) {})
+# - differentiate between `for my $x ...' and `my $x; for $x ...'
+# - various minor cleanups
+# - moved globals into an object
+# - added `-u', like B::C
+# - package declarations using cop_stash
+# - subs, formats and code sorted by cop_seq
+# Changes between 0.51 and 0.52:
+# - added pp_threadsv (special variables under USE_THREADS)
+# - added documentation
+# Changes between 0.52 and 0.53
+# - many changes adding precedence contexts and associativity
+# - added `-p' and `-s' output style options
+# - various other minor fixes
+# Changes between 0.53 and 0.54
+# - added support for new `for (1..100)' optimization,
+#   thanks to Gisle Aas
+# Changes between 0.54 and 0.55
+# - added support for new qr// construct
+# - added support for new pp_regcreset OP
+# Changes between 0.55 and 0.56
+# - tested on base/*.t, cmd/*.t, comp/*.t, io/*.t
+# - fixed $# on non-lexicals broken in last big rewrite
+# - added temporary fix for change in opcode of OP_STRINGIFY
+# - fixed problem in 0.54's for() patch in `for (@ary)'
+# - fixed precedence in conditional of ?:
+# - tweaked list paren elimination in `my($x) = @_'
+# - made continue-block detection trickier wrt. null ops
+# - fixed various prototype problems in pp_entersub
+# - added support for sub prototypes that never get GVs
+# - added unquoting for special filehandle first arg in truncate
+# - print doubled rv2gv (a bug) as `*{*GV}' instead of illegal `**GV'
+# - added semicolons at the ends of blocks
+# - added -l `#line' declaration option -- fixes cmd/subval.t 27,28
+
+# Todo:
+# - {} around variables in strings ("${var}letters")
+#   base/lex.t 25-27
+#   comp/term.t 11
+# - generate symbolic constants directly from core source
+# - left/right context
+# - avoid semis in one-statement blocks
+# - associativity of &&=, ||=, ?:
+# - ',' => '=>' (auto-unquote?)
+# - break long lines ("\r" as discretionary break?)
+# - include values of variables (e.g. set in BEGIN)
+# - coordinate with Data::Dumper (both directions? see previous)
+# - version using op_next instead of op_first/sibling?
+# - avoid string copies (pass arrays, one big join?)
+# - auto-apply `-u'?
+# - while{} with one-statement continue => for(; XXX; XXX) {}?
+# - -uPackage:: descend recursively?
+# - here-docs?
+# - <DATA>?
+
+# Tests that will always fail:
+# comp/redef.t -- all (redefinition happens at compile time)
+
+# Object fields (were globals):
+#
+# avoid_local:
+# (local($a), local($b)) and local($a, $b) have the same internal
+# representation but the short form looks better. We notice we can
+# use a large-scale local when checking the list, but need to prevent
+# individual locals too. This hash holds the addresses of OPs that 
+# have already had their local-ness accounted for. The same thing
+# is done with my().
+#
+# curcv:
+# CV for current sub (or main program) being deparsed
+#
+# curstash:
+# name of the current package for deparsed code
+#
+# subs_todo:
+# array of [cop_seq, GV, is_format?] for subs and formats we still
+# want to deparse
+#
+# protos_todo:
+# as above, but [name, prototype] for subs that never got a GV
+#
+# subs_done, forms_done:
+# keys are addresses of GVs for subs and formats we've already
+# deparsed (or at least put into subs_todo)
+#
+# parens: -p
+# linenums: -l
+# cuddle: ` ' or `\n', depending on -sC
+
+# A little explanation of how precedence contexts and associativity
+# work:
+#
+# deparse() calls each per-op subroutine with an argument $cx (short
+# for context, but not the same as the cx* in the perl core), which is
+# a number describing the op's parents in terms of precedence, whether
+# they're inside an expression or at statement level, etc.  (see
+# chart below). When ops with children call deparse on them, they pass
+# along their precedence. Fractional values are used to implement
+# associativity (`($x + $y) + $z' => `$x + $y + $y') and related
+# parentheses hacks. The major disadvantage of this scheme is that
+# it doesn't know about right sides and left sides, so say if you
+# assign a listop to a variable, it can't tell it's allowed to leave
+# the parens off the listop.
+
+# Precedences:
+# 26             [TODO] inside interpolation context ("")
+# 25 left        terms and list operators (leftward)
+# 24 left        ->
+# 23 nonassoc    ++ --
+# 22 right       **
+# 21 right       ! ~ \ and unary + and -
+# 20 left        =~ !~
+# 19 left        * / % x
+# 18 left        + - .
+# 17 left        << >>
+# 16 nonassoc    named unary operators
+# 15 nonassoc    < > <= >= lt gt le ge
+# 14 nonassoc    == != <=> eq ne cmp
+# 13 left        &
+# 12 left        | ^
+# 11 left        &&
+# 10 left        ||
+#  9 nonassoc    ..  ...
+#  8 right       ?:
+#  7 right       = += -= *= etc.
+#  6 left        , =>
+#  5 nonassoc    list operators (rightward)
+#  4 right       not
+#  3 left        and
+#  2 left        or xor
+#  1             statement modifiers
+#  0             statement level
+
+# Nonprinting characters with special meaning:
+# \cS - steal parens (see maybe_parens_unop)
+# \n - newline and indent
+# \t - increase indent
+# \b - decrease indent (`outdent')
+# \f - flush left (no indent)
+# \cK - kill following semicolon, if any
+
+sub null {
+    my $op = shift;
+    return class($op) eq "NULL";
+}
+
+sub todo {
+    my $self = shift;
+    my($gv, $cv, $is_form) = @_;
+    my $seq;
+    if (!null($cv->START) and is_state($cv->START)) {
+	$seq = $cv->START->cop_seq;
+    } else {
+	$seq = 0;
+    }
+    push @{$self->{'subs_todo'}}, [$seq, $gv, $is_form];
+}
+
+sub next_todo {
+    my $self = shift;
+    my $ent = shift @{$self->{'subs_todo'}};
+    my $name = $self->gv_name($ent->[1]);
+    if ($ent->[2]) {
+	return "format $name =\n"
+	    . $self->deparse_format($ent->[1]->FORM). "\n";
+    } else {
+	return "sub $name " .
+	    $self->deparse_sub($ent->[1]->CV);
+    }
+}
+
+sub OPf_KIDS () { 4 }
+
+sub walk_tree {
+    my($op, $sub) = @_;
+    $sub->($op);
+    if ($op->flags & OPf_KIDS) {
+	my $kid;
+	for ($kid = $op->first; not null $kid; $kid = $kid->sibling) {
+	    walk_tree($kid, $sub);
+	}
+    }
+}
+
+sub walk_sub {
+    my $self = shift;
+    my $cv = shift;
+    my $op = $cv->ROOT;
+    $op = shift if null $op;
+    return if !$op or null $op;
+    walk_tree($op, sub {
+	my $op = shift;
+	if ($op->ppaddr eq "pp_gv") {
+	    if ($op->next->ppaddr eq "pp_entersub") {
+		next if $self->{'subs_done'}{$ {$op->gv}}++;
+		next if class($op->gv->CV) eq "SPECIAL";
+		$self->todo($op->gv, $op->gv->CV, 0);
+		$self->walk_sub($op->gv->CV);
+	    } elsif ($op->next->ppaddr eq "pp_enterwrite"
+		     or ($op->next->ppaddr eq "pp_rv2gv"
+			 and $op->next->next->ppaddr eq "pp_enterwrite")) {
+		next if $self->{'forms_done'}{$ {$op->gv}}++;
+		next if class($op->gv->FORM) eq "SPECIAL";
+		$self->todo($op->gv, $op->gv->FORM, 1);
+		$self->walk_sub($op->gv->FORM);
+	    }
+	}
+    });
+}
+
+sub stash_subs {
+    my $self = shift;
+    my $pack = shift;
+    my(%stash, @ret);
+    { no strict 'refs'; %stash = svref_2object(\%{$pack . "::"})->ARRAY }
+    if ($pack eq "main") {
+	$pack = "";
+    } else {
+	$pack = $pack . "::";
+    }
+    my($key, $val);
+    while (($key, $val) = each %stash) {
+	my $class = class($val);
+	if ($class eq "PV") {
+	    # Just a prototype
+	    push @{$self->{'protos_todo'}}, [$pack . $key, $val->PV];
+	} elsif ($class eq "IV") {
+	    # Just a name
+	    push @{$self->{'protos_todo'}}, [$pack . $key, undef];	    
+	} elsif ($class eq "GV") {
+	    if (class($val->CV) ne "SPECIAL") {
+		next if $self->{'subs_done'}{$$val}++;
+		$self->todo($val, $val->CV, 0);
+		$self->walk_sub($val->CV);
+	    }
+	    if (class($val->FORM) ne "SPECIAL") {
+		next if $self->{'forms_done'}{$$val}++;
+		$self->todo($val, $val->FORM, 1);
+		$self->walk_sub($val->FORM);
+	    }
+	}
+    }
+}
+
+sub print_protos {
+    my $self = shift;
+    my $ar;
+    my @ret;
+    foreach $ar (@{$self->{'protos_todo'}}) {
+	my $proto = (defined $ar->[1] ? " (". $ar->[1] . ")" : "");
+	push @ret, "sub " . $ar->[0] .  "$proto;\n";
+    }
+    delete $self->{'protos_todo'};
+    return @ret;
+}
+
+sub style_opts {
+    my $self = shift;
+    my $opts = shift;
+    my $opt;
+    while (length($opt = substr($opts, 0, 1))) {
+	if ($opt eq "C") {
+	    $self->{'cuddle'} = " ";
+	}
+	$opts = substr($opts, 1);
+    }
+}
+
+sub compile {
+    my(@args) = @_;
+    return sub { 
+	my $self = bless {};
+	my $arg;
+	$self->{'subs_todo'} = [];
+	$self->stash_subs("main");
+	$self->{'curcv'} = main_cv;
+	$self->{'curstash'} = "main";
+	$self->{'cuddle'} = "\n";
+	while ($arg = shift @args) {
+	    if (substr($arg, 0, 2) eq "-u") {
+		$self->stash_subs(substr($arg, 2));
+	    } elsif ($arg eq "-p") {
+		$self->{'parens'} = 1;
+	    } elsif ($arg eq "-l") {
+		$self->{'linenums'} = 1;
+	    } elsif (substr($arg, 0, 2) eq "-s") {
+		$self->style_opts(substr $arg, 2);
+	    }
+	}
+	$self->walk_sub(main_cv, main_start);
+	print $self->print_protos;
+	@{$self->{'subs_todo'}} =
+	    sort {$a->[0] <=> $b->[0]} @{$self->{'subs_todo'}};
+	print indent($self->deparse(main_root, 0)), "\n" unless null main_root;
+	my @text;
+	while (scalar(@{$self->{'subs_todo'}})) {
+	    push @text, $self->next_todo;
+	}
+	print indent(join("", @text)), "\n" if @text;
+    }
+}
+
+sub deparse {
+    my $self = shift;
+    my($op, $cx) = @_;
+#    cluck if class($op) eq "NULL";
+    my $meth = $op->ppaddr;
+    return $self->$meth($op, $cx);
+}
+
+sub indent {
+    my $txt = shift;
+    my @lines = split(/\n/, $txt);
+    my $leader = "";
+    my $line;
+    for $line (@lines) {
+	if (substr($line, 0, 1) eq "\t") {
+	    $leader = $leader . "    ";
+	    $line = substr($line, 1);
+	} elsif (substr($line, 0, 1) eq "\b") {
+	    $leader = substr($leader, 0, length($leader) - 4);
+	    $line = substr($line, 1);
+	}
+	if (substr($line, 0, 1) eq "\f") {
+	    $line = substr($line, 1); # no indent
+	} else {
+	    $line = $leader . $line;
+	}
+	$line =~ s/\cK;?//g;
+    }
+    return join("\n", @lines);
+}
+
+sub SVf_POK () {0x40000}
+
+sub deparse_sub {
+    my $self = shift;
+    my $cv = shift;
+    my $proto = "";
+    if ($cv->FLAGS & SVf_POK) {
+	$proto = "(". $cv->PV . ") ";
+    }
+    local($self->{'curcv'}) = $cv;
+    local($self->{'curstash'}) = $self->{'curstash'};
+    if (not null $cv->ROOT) {
+	# skip leavesub
+	return $proto . "{\n\t" . 
+	    $self->deparse($cv->ROOT->first, 0) . "\n\b}\n"; 
+    } else { # XSUB?
+	return $proto  . "{}\n";
+    }
+}
+
+sub deparse_format {
+    my $self = shift;
+    my $form = shift;
+    my @text;
+    local($self->{'curcv'}) = $form;
+    local($self->{'curstash'}) = $self->{'curstash'};
+    my $op = $form->ROOT;
+    my $kid;
+    $op = $op->first->first; # skip leavewrite, lineseq
+    while (not null $op) {
+	$op = $op->sibling; # skip nextstate
+	my @exprs;
+	$kid = $op->first->sibling; # skip pushmark
+	push @text, $kid->sv->PV;
+	$kid = $kid->sibling;
+	for (; not null $kid; $kid = $kid->sibling) {
+	    push @exprs, $self->deparse($kid, 0);
+	}
+	push @text, join(", ", @exprs)."\n" if @exprs;
+	$op = $op->sibling;
+    }
+    return join("", @text) . ".";
+}
+
+# the aassign in-common check messes up SvCUR (always setting it
+# to a value >= 100), but it's probably safe to assume there
+# won't be any NULs in the names of my() variables. (with
+# stash variables, I wouldn't be so sure)
+sub padname_fix {
+    my $str = shift;
+    $str = substr($str, 0, index($str, "\0")) if index($str, "\0") != -1;
+    return $str;
+}
+
+sub is_scope {
+    my $op = shift;
+    return $op->ppaddr eq "pp_leave" || $op->ppaddr eq "pp_scope"
+      || $op->ppaddr eq "pp_lineseq"
+	|| ($op->ppaddr eq "pp_null" && class($op) eq "UNOP" 
+	    && (is_scope($op->first) || $op->first->ppaddr eq "pp_enter"));
+}
+
+sub is_state {
+    my $name = $_[0]->ppaddr;
+    return $name eq "pp_nextstate" || $name eq "pp_dbstate";
+}
+
+sub is_miniwhile { # check for one-line loop (`foo() while $y--')
+    my $op = shift;
+    return (!null($op) and null($op->sibling) 
+	    and $op->ppaddr eq "pp_null" and class($op) eq "UNOP"
+	    and (($op->first->ppaddr =~ /^pp_(and|or)$/
+		  and $op->first->first->sibling->ppaddr eq "pp_lineseq")
+		 or ($op->first->ppaddr eq "pp_lineseq"
+		     and not null $op->first->first->sibling
+		     and $op->first->first->sibling->ppaddr eq "pp_unstack")
+		 ));
+}
+
+sub is_scalar {
+    my $op = shift;
+    return ($op->ppaddr eq "pp_rv2sv" or
+	    $op->ppaddr eq "pp_padsv" or
+	    $op->ppaddr eq "pp_gv" or # only in array/hash constructs
+	    !null($op->first) && $op->first->ppaddr eq "pp_gvsv");
+}
+
+sub maybe_parens {
+    my $self = shift;
+    my($text, $cx, $prec) = @_;
+    if ($prec < $cx              # unary ops nest just fine
+	or $prec == $cx and $cx != 4 and $cx != 16 and $cx != 21
+	or $self->{'parens'})
+    {
+	$text = "($text)";
+	# In a unop, let parent reuse our parens; see maybe_parens_unop
+	$text = "\cS" . $text if $cx == 16;
+	return $text;
+    } else {
+	return $text;
+    }
+}
+
+# same as above, but get around the `if it looks like a function' rule
+sub maybe_parens_unop {
+    my $self = shift;
+    my($name, $kid, $cx) = @_;
+    if ($cx > 16 or $self->{'parens'}) {
+	return "$name(" . $self->deparse($kid, 1) . ")";
+    } else {
+	$kid = $self->deparse($kid, 16);
+	if (substr($kid, 0, 1) eq "\cS") {
+	    # use kid's parens
+	    return $name . substr($kid, 1);
+	} elsif (substr($kid, 0, 1) eq "(") {
+	    # avoid looks-like-a-function trap with extra parens
+	    # (`+' can lead to ambiguities)
+	    return "$name(" . $kid  . ")";
+	} else {
+	    return "$name $kid";
+	}
+    }
+}
+
+sub maybe_parens_func {
+    my $self = shift;
+    my($func, $text, $cx, $prec) = @_;
+    if ($prec <= $cx or substr($text, 0, 1) eq "(" or $self->{'parens'}) {
+	return "$func($text)";
+    } else {
+	return "$func $text";
+    }
+}
+
+sub OPp_LVAL_INTRO () { 128 }
+
+sub maybe_local {
+    my $self = shift;
+    my($op, $cx, $text) = @_;
+    if ($op->private & OPp_LVAL_INTRO and not $self->{'avoid_local'}{$$op}) {
+	return $self->maybe_parens_func("local", $text, $cx, 16);
+    } else {
+	return $text;
+    }
+}
+
+sub padname_sv {
+    my $self = shift;
+    my $targ = shift;
+    return (($self->{'curcv'}->PADLIST->ARRAY)[0]->ARRAY)[$targ];
+}
+
+sub maybe_my {
+    my $self = shift;
+    my($op, $cx, $text) = @_;
+    if ($op->private & OPp_LVAL_INTRO and not $self->{'avoid_local'}{$$op}) {
+	return $self->maybe_parens_func("my", $text, $cx, 16);
+    } else {
+	return $text;
+    }
+}
+
+# The following OPs don't have functions:
+
+# pp_padany -- does not exist after parsing
+# pp_rcatline -- does not exist
+
+sub pp_enter { # see also leave
+    cluck "unexpected OP_ENTER";
+    return "XXX";
+}
+
+sub pp_pushmark { # see also list
+    cluck "unexpected OP_PUSHMARK";
+    return "XXX";
+}
+
+sub pp_leavesub { # see also deparse_sub
+    cluck "unexpected OP_LEAVESUB";
+    return "XXX";
+}
+
+sub pp_leavewrite { # see also deparse_format
+    cluck "unexpected OP_LEAVEWRITE";
+    return "XXX";
+}
+
+sub pp_method { # see also entersub
+    cluck "unexpected OP_METHOD";
+    return "XXX";
+}
+
+sub pp_regcmaybe { # see also regcomp
+    cluck "unexpected OP_REGCMAYBE";
+    return "XXX";
+}
+
+sub pp_regcreset { # see also regcomp
+    cluck "unexpected OP_REGCRESET";
+    return "XXX";
+}
+
+sub pp_substcont { # see also subst
+    cluck "unexpected OP_SUBSTCONT";
+    return "XXX";
+}
+
+sub pp_grepstart { # see also grepwhile
+    cluck "unexpected OP_GREPSTART";
+    return "XXX";
+}
+
+sub pp_mapstart { # see also mapwhile
+    cluck "unexpected OP_MAPSTART";
+    return "XXX";
+}
+
+sub pp_flip { # see also flop
+    cluck "unexpected OP_FLIP";
+    return "XXX";
+}
+
+sub pp_iter { # see also leaveloop
+    cluck "unexpected OP_ITER";
+    return "XXX";
+}
+
+sub pp_enteriter { # see also leaveloop
+    cluck "unexpected OP_ENTERITER";
+    return "XXX";
+}
+
+sub pp_enterloop { # see also leaveloop
+    cluck "unexpected OP_ENTERLOOP";
+    return "XXX";
+}
+
+sub pp_leaveeval { # see also entereval
+    cluck "unexpected OP_LEAVEEVAL";
+    return "XXX";
+}
+
+sub pp_entertry { # see also leavetry
+    cluck "unexpected OP_ENTERTRY";
+    return "XXX";
+}
+
+# leave and scope/lineseq should probably share code
+sub pp_leave {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my ($kid, $expr);
+    my @exprs;
+    local($self->{'curstash'}) = $self->{'curstash'};
+    $kid = $op->first->sibling; # skip enter
+    if (is_miniwhile($kid)) {
+	my $top = $kid->first;
+	my $name = $top->ppaddr;
+	if ($name eq "pp_and") {
+	    $name = "while";
+	} elsif ($name eq "pp_or") {
+	    $name = "until";
+	} else { # no conditional -> while 1 or until 0
+	    return $self->deparse($top->first, 1) . " while 1";
+	}
+	my $cond = $top->first;
+	my $body = $cond->sibling->first; # skip lineseq
+	$cond = $self->deparse($cond, 1);
+	$body = $self->deparse($body, 1);
+	return "$body $name $cond";
+    }
+    for (; !null($kid); $kid = $kid->sibling) {
+	$expr = "";
+	if (is_state $kid) {
+	    $expr = $self->deparse($kid, 0);
+	    $kid = $kid->sibling;
+	    last if null $kid;
+	}
+	$expr .= $self->deparse($kid, 0);
+	push @exprs, $expr if $expr;
+    }
+    if ($cx > 0) { # inside an expression
+	return "do { " . join(";\n", @exprs) . " }";
+    } else {
+	return join(";\n", @exprs) . ";";
+    }
+}
+
+sub pp_scope {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my ($kid, $expr);
+    my @exprs;
+    for ($kid = $op->first; !null($kid); $kid = $kid->sibling) {
+	$expr = "";
+	if (is_state $kid) {
+	    $expr = $self->deparse($kid, 0);
+	    $kid = $kid->sibling;
+	    last if null $kid;
+	}
+	$expr .= $self->deparse($kid, 0);
+	push @exprs, $expr if $expr;
+    }
+    if ($cx > 0) { # inside an expression, (a do {} while for lineseq)
+	return "do { " . join(";\n", @exprs) . " }";
+    } else {
+	return join(";\n", @exprs) . ";";
+    }
+}
+
+sub pp_lineseq { pp_scope(@_) }
+
+# The BEGIN {} is used here because otherwise this code isn't executed
+# when you run B::Deparse on itself.
+my %globalnames;
+BEGIN { map($globalnames{$_}++, "SIG", "STDIN", "STDOUT", "STDERR", "INC",
+	    "ENV", "ARGV", "ARGVOUT", "_"); }
+
+sub gv_name {
+    my $self = shift;
+    my $gv = shift;
+    my $stash = $gv->STASH->NAME;
+    my $name = $gv->NAME;
+    if ($stash eq $self->{'curstash'} or $globalnames{$name}
+	or $name =~ /^[^A-Za-z_]/)
+    {
+	$stash = "";
+    } else {
+	$stash = $stash . "::";
+    }
+    if ($name =~ /^([\cA-\cZ])$/) {
+	$name = "^" . chr(64 + ord($1));
+    }
+    return $stash . $name;
+}
+
+# Notice how subs and formats are inserted between statements here
+sub pp_nextstate {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my @text;
+    @text = $op->label . ": " if $op->label;
+    my $seq = $op->cop_seq;
+    while (scalar(@{$self->{'subs_todo'}})
+	   and $seq > $self->{'subs_todo'}[0][0]) {
+	push @text, $self->next_todo;
+    }
+    my $stash = $op->stash->NAME;
+    if ($stash ne $self->{'curstash'}) {
+	push @text, "package $stash;\n";
+	$self->{'curstash'} = $stash;
+    }
+    if ($self->{'linenums'}) {
+	push @text, "\f#line " . $op->line . 
+	  ' "' . substr($op->filegv->NAME, 2), qq'"\n';
+    }
+    return join("", @text);
+}
+
+sub pp_dbstate { pp_nextstate(@_) }
+
+sub pp_unstack { return "" } # see also leaveloop
+
+sub baseop {
+    my $self = shift;
+    my($op, $cx, $name) = @_;
+    return $name;
+}
+
+sub pp_stub { baseop(@_, "()") }
+sub pp_wantarray { baseop(@_, "wantarray") }
+sub pp_fork { baseop(@_, "fork") }
+sub pp_wait { baseop(@_, "wait") }
+sub pp_getppid { baseop(@_, "getppid") }
+sub pp_time { baseop(@_, "time") }
+sub pp_tms { baseop(@_, "times") }
+sub pp_ghostent { baseop(@_, "gethostent") }
+sub pp_gnetent { baseop(@_, "getnetent") }
+sub pp_gprotoent { baseop(@_, "getprotoent") }
+sub pp_gservent { baseop(@_, "getservent") }
+sub pp_ehostent { baseop(@_, "endhostent") }
+sub pp_enetent { baseop(@_, "endnetent") }
+sub pp_eprotoent { baseop(@_, "endprotoent") }
+sub pp_eservent { baseop(@_, "endservent") }
+sub pp_gpwent { baseop(@_, "getpwent") }
+sub pp_spwent { baseop(@_, "setpwent") }
+sub pp_epwent { baseop(@_, "endpwent") }
+sub pp_ggrent { baseop(@_, "getgrent") }
+sub pp_sgrent { baseop(@_, "setgrent") }
+sub pp_egrent { baseop(@_, "endgrent") }
+sub pp_getlogin { baseop(@_, "getlogin") }
+
+sub POSTFIX () { 1 }
+
+# I couldn't think of a good short name, but this is the category of
+# symbolic unary operators with interesting precedence
+
+sub pfixop {
+    my $self = shift;
+    my($op, $cx, $name, $prec, $flags) = (@_, 0);
+    my $kid = $op->first;
+    $kid = $self->deparse($kid, $prec);
+    return $self->maybe_parens(($flags & POSTFIX) ? "$kid$name" : "$name$kid",
+			       $cx, $prec);
+}
+
+sub pp_preinc { pfixop(@_, "++", 23) }
+sub pp_predec { pfixop(@_, "--", 23) }
+sub pp_postinc { pfixop(@_, "++", 23, POSTFIX) }
+sub pp_postdec { pfixop(@_, "--", 23, POSTFIX) }
+sub pp_i_preinc { pfixop(@_, "++", 23) }
+sub pp_i_predec { pfixop(@_, "--", 23) }
+sub pp_i_postinc { pfixop(@_, "++", 23, POSTFIX) }
+sub pp_i_postdec { pfixop(@_, "--", 23, POSTFIX) }
+sub pp_complement { pfixop(@_, "~", 21) }
+
+sub pp_negate {
+    my $self = shift;
+    my($op, $cx) = @_;
+    if ($op->first->ppaddr =~ /^pp_(i_)?negate$/) {
+	# avoid --$x
+	$self->pfixop($op, $cx, "-", 21.5);
+    } else {
+	$self->pfixop($op, $cx, "-", 21);	
+    }
+}
+sub pp_i_negate { pp_negate(@_) }
+
+sub pp_not {
+    my $self = shift;
+    my($op, $cx) = @_;
+    if ($cx <= 4) {
+	$self->pfixop($op, $cx, "not ", 4);
+    } else {
+	$self->pfixop($op, $cx, "!", 21);	
+    }
+}
+
+sub OPf_SPECIAL () { 128 }
+
+sub unop {
+    my $self = shift;
+    my($op, $cx, $name, $prec, $flags) = (@_, 0, 0);
+    my $kid;
+    if ($op->flags & OPf_KIDS) {
+	$kid = $op->first;
+	return $self->maybe_parens_unop($name, $kid, $cx);
+    } else {
+	return $name .  ($op->flags & OPf_SPECIAL ? "()" : "");       
+    }
+}
+
+sub pp_chop { unop(@_, "chop") }
+sub pp_chomp { unop(@_, "chomp") }
+sub pp_schop { unop(@_, "chop") }
+sub pp_schomp { unop(@_, "chomp") }
+sub pp_defined { unop(@_, "defined") }
+sub pp_undef { unop(@_, "undef") }
+sub pp_study { unop(@_, "study") }
+sub pp_ref { unop(@_, "ref") }
+sub pp_pos { maybe_local(@_, unop(@_, "pos")) }
+
+sub pp_sin { unop(@_, "sin") }
+sub pp_cos { unop(@_, "cos") }
+sub pp_rand { unop(@_, "rand") }
+sub pp_srand { unop(@_, "srand") }
+sub pp_exp { unop(@_, "exp") }
+sub pp_log { unop(@_, "log") }
+sub pp_sqrt { unop(@_, "sqrt") }
+sub pp_int { unop(@_, "int") }
+sub pp_hex { unop(@_, "hex") }
+sub pp_oct { unop(@_, "oct") }
+sub pp_abs { unop(@_, "abs") }
+
+sub pp_length { unop(@_, "length") }
+sub pp_ord { unop(@_, "ord") }
+sub pp_chr { unop(@_, "chr") }
+sub pp_ucfirst { unop(@_, "ucfirst") }
+sub pp_lcfirst { unop(@_, "lcfirst") }
+sub pp_uc { unop(@_, "uc") }
+sub pp_lc { unop(@_, "lc") }
+sub pp_quotemeta { unop(@_, "quotemeta") }
+
+sub pp_each { unop(@_, "each") }
+sub pp_values { unop(@_, "values") }
+sub pp_keys { unop(@_, "keys") }
+sub pp_pop { unop(@_, "pop") }
+sub pp_shift { unop(@_, "shift") }
+
+sub pp_caller { unop(@_, "caller") }
+sub pp_reset { unop(@_, "reset") }
+sub pp_exit { unop(@_, "exit") }
+sub pp_prototype { unop(@_, "prototype") }
+
+sub pp_close { unop(@_, "close") }
+sub pp_fileno { unop(@_, "fileno") }
+sub pp_umask { unop(@_, "umask") }
+sub pp_binmode { unop(@_, "binmode") }
+sub pp_untie { unop(@_, "untie") }
+sub pp_tied { unop(@_, "tied") }
+sub pp_dbmclose { unop(@_, "dbmclose") }
+sub pp_getc { unop(@_, "getc") }
+sub pp_eof { unop(@_, "eof") }
+sub pp_tell { unop(@_, "tell") }
+sub pp_getsockname { unop(@_, "getsockname") }
+sub pp_getpeername { unop(@_, "getpeername") }
+
+sub pp_chdir { unop(@_, "chdir") }
+sub pp_chroot { unop(@_, "chroot") }
+sub pp_readlink { unop(@_, "readlink") }
+sub pp_rmdir { unop(@_, "rmdir") }
+sub pp_readdir { unop(@_, "readdir") }
+sub pp_telldir { unop(@_, "telldir") }
+sub pp_rewinddir { unop(@_, "rewinddir") }
+sub pp_closedir { unop(@_, "closedir") }
+sub pp_getpgrp { unop(@_, "getpgrp") }
+sub pp_localtime { unop(@_, "localtime") }
+sub pp_gmtime { unop(@_, "gmtime") }
+sub pp_alarm { unop(@_, "alarm") }
+sub pp_sleep { unop(@_, "sleep") }
+
+sub pp_dofile { unop(@_, "do") }
+sub pp_entereval { unop(@_, "eval") }
+
+sub pp_ghbyname { unop(@_, "gethostbyname") }
+sub pp_gnbyname { unop(@_, "getnetbyname") }
+sub pp_gpbyname { unop(@_, "getprotobyname") }
+sub pp_shostent { unop(@_, "sethostent") }
+sub pp_snetent { unop(@_, "setnetent") }
+sub pp_sprotoent { unop(@_, "setprotoent") }
+sub pp_sservent { unop(@_, "setservent") }
+sub pp_gpwnam { unop(@_, "getpwnam") }
+sub pp_gpwuid { unop(@_, "getpwuid") }
+sub pp_ggrnam { unop(@_, "getgrnam") }
+sub pp_ggrgid { unop(@_, "getgrgid") }
+
+sub pp_lock { unop(@_, "lock") }
+
+sub pp_exists {
+    my $self = shift;
+    my($op, $cx) = @_;
+    return $self->maybe_parens_func("exists", $self->pp_helem($op->first, 16),
+				    $cx, 16);
+}
+
+sub OPpSLICE () { 64 }
+
+sub pp_delete {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my $arg;
+    if ($op->private & OPpSLICE) {
+	return $self->maybe_parens_func("delete",
+					$self->pp_hslice($op->first, 16),
+					$cx, 16);
+    } else {
+	return $self->maybe_parens_func("delete",
+					$self->pp_helem($op->first, 16),
+					$cx, 16);
+    }
+}
+
+sub OPp_CONST_BARE () { 64 }
+
+sub pp_require {
+    my $self = shift;
+    my($op, $cx) = @_;
+    if (class($op) eq "UNOP" and $op->first->ppaddr eq "pp_const"
+	and $op->first->private & OPp_CONST_BARE)
+    {
+	my $name = $op->first->sv->PV;
+	$name =~ s[/][::]g;
+	$name =~ s/\.pm//g;
+	return "require($name)";
+    } else {	
+	$self->unop($op, $cx, "require");
+    }
+}
+
+sub pp_scalar { 
+    my $self = shift;
+    my($op, $cv) = @_;
+    my $kid = $op->first;
+    if (not null $kid->sibling) {
+	# XXX Was a here-doc
+	return $self->dquote($op);
+    }
+    $self->unop(@_, "scalar");
+}
+
+
+sub padval {
+    my $self = shift;
+    my $targ = shift;
+    return (($self->{'curcv'}->PADLIST->ARRAY)[1]->ARRAY)[$targ];
+}
+
+sub OPf_REF () { 16 }
+
+sub pp_refgen {
+    my $self = shift;	
+    my($op, $cx) = @_;
+    my $kid = $op->first;
+    if ($kid->ppaddr eq "pp_null") {
+	$kid = $kid->first;
+	if ($kid->ppaddr eq "pp_anonlist" || $kid->ppaddr eq "pp_anonhash") {
+	    my($pre, $post) = @{{"pp_anonlist" => ["[","]"],
+				 "pp_anonhash" => ["{","}"]}->{$kid->ppaddr}};
+	    my($expr, @exprs);
+	    $kid = $kid->first->sibling; # skip pushmark
+	    for (; !null($kid); $kid = $kid->sibling) {
+		$expr = $self->deparse($kid, 6);
+		push @exprs, $expr;
+	    }
+	    return $pre . join(", ", @exprs) . $post;
+	} elsif (!null($kid->sibling) and 
+		 $kid->sibling->ppaddr eq "pp_anoncode") {
+	    return "sub " .
+		$self->deparse_sub($self->padval($kid->sibling->targ));
+	} elsif ($kid->ppaddr eq "pp_pushmark"
+		 and $kid->sibling->ppaddr =~ /^pp_(pad|rv2)[ah]v$/
+		 and not $kid->sibling->flags & OPf_REF) {
+	    # The @a in \(@a) isn't in ref context, but only when the
+	    # parens are there.
+	    return "\\(" . $self->deparse($kid->sibling, 1) . ")";
+	}
+    }
+    $self->pfixop($op, $cx, "\\", 20);
+}
+
+sub pp_srefgen { pp_refgen(@_) }
+
+sub pp_readline {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my $kid = $op->first;
+    $kid = $kid->first if $kid->ppaddr eq "pp_rv2gv"; # <$fh>
+    if ($kid->ppaddr eq "pp_rv2gv") {
+	$kid = $kid->first;
+    }
+    return "<" . $self->deparse($kid, 1) . ">";
+}
+
+sub loopex {
+    my $self = shift;
+    my ($op, $cx, $name) = @_;
+    if (class($op) eq "PVOP") {
+	return "$name " . $op->pv;
+    } elsif (class($op) eq "OP") {
+	return $name;
+    } elsif (class($op) eq "UNOP") {
+	# Note -- loop exits are actually exempt from the
+	# looks-like-a-func rule, but a few extra parens won't hurt
+	return $self->maybe_parens_unop($name, $op->first, $cx);
+    }
+}
+
+sub pp_last { loopex(@_, "last") }
+sub pp_next { loopex(@_, "next") }
+sub pp_redo { loopex(@_, "redo") }
+sub pp_goto { loopex(@_, "goto") }
+sub pp_dump { loopex(@_, "dump") }
+
+sub ftst {
+    my $self = shift;
+    my($op, $cx, $name) = @_;
+    if (class($op) eq "UNOP") {
+	# Genuine `-X' filetests are exempt from the LLAFR, but not
+	# l?stat(); for the sake of clarity, give'em all parens
+	return $self->maybe_parens_unop($name, $op->first, $cx);
+    } elsif (class($op) eq "GVOP") {
+	return $self->maybe_parens_func($name, $self->pp_gv($op, 1), $cx, 16);
+    } else { # I don't think baseop filetests ever survive ck_ftst, but...
+	return $name;
+    }
+}
+
+sub pp_lstat { ftst(@_, "lstat") }
+sub pp_stat { ftst(@_, "stat") }
+sub pp_ftrread { ftst(@_, "-R") }
+sub pp_ftrwrite { ftst(@_, "-W") }
+sub pp_ftrexec { ftst(@_, "-X") }
+sub pp_fteread { ftst(@_, "-r") }
+sub pp_ftewrite { ftst(@_, "-r") }
+sub pp_fteexec { ftst(@_, "-r") }
+sub pp_ftis { ftst(@_, "-e") }
+sub pp_fteowned { ftst(@_, "-O") }
+sub pp_ftrowned { ftst(@_, "-o") }
+sub pp_ftzero { ftst(@_, "-z") }
+sub pp_ftsize { ftst(@_, "-s") }
+sub pp_ftmtime { ftst(@_, "-M") }
+sub pp_ftatime { ftst(@_, "-A") }
+sub pp_ftctime { ftst(@_, "-C") }
+sub pp_ftsock { ftst(@_, "-S") }
+sub pp_ftchr { ftst(@_, "-c") }
+sub pp_ftblk { ftst(@_, "-b") }
+sub pp_ftfile { ftst(@_, "-f") }
+sub pp_ftdir { ftst(@_, "-d") }
+sub pp_ftpipe { ftst(@_, "-p") }
+sub pp_ftlink { ftst(@_, "-l") }
+sub pp_ftsuid { ftst(@_, "-u") }
+sub pp_ftsgid { ftst(@_, "-g") }
+sub pp_ftsvtx { ftst(@_, "-k") }
+sub pp_fttty { ftst(@_, "-t") }
+sub pp_fttext { ftst(@_, "-T") }
+sub pp_ftbinary { ftst(@_, "-B") }
+
+sub SWAP_CHILDREN () { 1 }
+sub ASSIGN () { 2 } # has OP= variant
+
+sub OPf_STACKED () { 64 }
+
+my(%left, %right);
+
+sub assoc_class {
+    my $op = shift;
+    my $name = $op->ppaddr;
+    if ($name eq "pp_concat" and $op->first->ppaddr eq "pp_concat") {
+	# avoid spurious `=' -- see comment in pp_concat
+	return "pp_concat";
+    }
+    if ($name eq "pp_null" and class($op) eq "UNOP"
+	and $op->first->ppaddr =~ /^pp_(and|x?or)$/
+	and null $op->first->sibling)
+    {
+	# Like all conditional constructs, OP_ANDs and OP_ORs are topped
+	# with a null that's used as the common end point of the two
+	# flows of control. For precedence purposes, ignore it.
+	# (COND_EXPRs have these too, but we don't bother with
+	# their associativity).
+	return assoc_class($op->first);
+    }
+    return $name . ($op->flags & OPf_STACKED ? "=" : "");
+}
+
+# Left associative operators, like `+', for which
+# $a + $b + $c is equivalent to ($a + $b) + $c
+
+BEGIN {
+    %left = ('pp_multiply' => 19, 'pp_i_multiply' => 19,
+	     'pp_divide' => 19, 'pp_i_divide' => 19,
+	     'pp_modulo' => 19, 'pp_i_modulo' => 19,
+	     'pp_repeat' => 19,
+	     'pp_add' => 18, 'pp_i_add' => 18,
+	     'pp_subtract' => 18, 'pp_i_subtract' => 18,
+	     'pp_concat' => 18,
+	     'pp_left_shift' => 17, 'pp_right_shift' => 17,
+	     'pp_bit_and' => 13,
+	     'pp_bit_or' => 12, 'pp_bit_xor' => 12,
+	     'pp_and' => 3,
+	     'pp_or' => 2, 'pp_xor' => 2,
+	    );
+}
+
+sub deparse_binop_left {
+    my $self = shift;
+    my($op, $left, $prec) = @_;
+    if ($left{assoc_class($op)}
+	and $left{assoc_class($op)} == $left{assoc_class($left)})
+    {
+	return $self->deparse($left, $prec - .00001);
+    } else {
+	return $self->deparse($left, $prec);	
+    }
+}
+
+# Right associative operators, like `=', for which
+# $a = $b = $c is equivalent to $a = ($b = $c)
+
+BEGIN {
+    %right = ('pp_pow' => 22,
+	      'pp_sassign=' => 7, 'pp_aassign=' => 7,
+	      'pp_multiply=' => 7, 'pp_i_multiply=' => 7,
+	      'pp_divide=' => 7, 'pp_i_divide=' => 7,
+	      'pp_modulo=' => 7, 'pp_i_modulo=' => 7,
+	      'pp_repeat=' => 7,
+	      'pp_add=' => 7, 'pp_i_add=' => 7,
+	      'pp_subtract=' => 7, 'pp_i_subtract=' => 7,
+	      'pp_concat=' => 7,
+	      'pp_left_shift=' => 7, 'pp_right_shift=' => 7,
+	      'pp_bit_and=' => 7,
+	      'pp_bit_or=' => 7, 'pp_bit_xor=' => 7,
+	      'pp_andassign' => 7,
+	      'pp_orassign' => 7,
+	     );
+}
+
+sub deparse_binop_right {
+    my $self = shift;
+    my($op, $right, $prec) = @_;
+    if ($right{assoc_class($op)}
+	and $right{assoc_class($op)} == $right{assoc_class($right)})
+    {
+	return $self->deparse($right, $prec - .00001);
+    } else {
+	return $self->deparse($right, $prec);	
+    }
+}
+
+sub binop {
+    my $self = shift;
+    my ($op, $cx, $opname, $prec, $flags) = (@_, 0);
+    my $left = $op->first;
+    my $right = $op->last;
+    my $eq = "";
+    if ($op->flags & OPf_STACKED && $flags & ASSIGN) {
+	$eq = "=";
+	$prec = 7;
+    }
+    if ($flags & SWAP_CHILDREN) {
+	($left, $right) = ($right, $left);
+    }
+    $left = $self->deparse_binop_left($op, $left, $prec);
+    $right = $self->deparse_binop_right($op, $right, $prec);
+    return $self->maybe_parens("$left $opname$eq $right", $cx, $prec);
+}
+
+sub pp_add { binop(@_, "+", 18, ASSIGN) }
+sub pp_multiply { binop(@_, "*", 19, ASSIGN) }
+sub pp_subtract { binop(@_, "-",18,  ASSIGN) }
+sub pp_divide { binop(@_, "/", 19, ASSIGN) }
+sub pp_modulo { binop(@_, "%", 19, ASSIGN) }
+sub pp_i_add { binop(@_, "+", 18, ASSIGN) }
+sub pp_i_multiply { binop(@_, "*", 19, ASSIGN) }
+sub pp_i_subtract { binop(@_, "-", 18, ASSIGN) }
+sub pp_i_divide { binop(@_, "/", 19, ASSIGN) }
+sub pp_i_modulo { binop(@_, "%", 19, ASSIGN) }
+sub pp_pow { binop(@_, "**", 22, ASSIGN) }
+
+sub pp_left_shift { binop(@_, "<<", 17, ASSIGN) }
+sub pp_right_shift { binop(@_, ">>", 17, ASSIGN) }
+sub pp_bit_and { binop(@_, "&", 13, ASSIGN) }
+sub pp_bit_or { binop(@_, "|", 12, ASSIGN) }
+sub pp_bit_xor { binop(@_, "^", 12, ASSIGN) }
+
+sub pp_eq { binop(@_, "==", 14) }
+sub pp_ne { binop(@_, "!=", 14) }
+sub pp_lt { binop(@_, "<", 15) }
+sub pp_gt { binop(@_, ">", 15) }
+sub pp_ge { binop(@_, ">=", 15) }
+sub pp_le { binop(@_, "<=", 15) }
+sub pp_ncmp { binop(@_, "<=>", 14) }
+sub pp_i_eq { binop(@_, "==", 14) }
+sub pp_i_ne { binop(@_, "!=", 14) }
+sub pp_i_lt { binop(@_, "<", 15) }
+sub pp_i_gt { binop(@_, ">", 15) }
+sub pp_i_ge { binop(@_, ">=", 15) }
+sub pp_i_le { binop(@_, "<=", 15) }
+sub pp_i_ncmp { binop(@_, "<=>", 14) }
+
+sub pp_seq { binop(@_, "eq", 14) }
+sub pp_sne { binop(@_, "ne", 14) }
+sub pp_slt { binop(@_, "lt", 15) }
+sub pp_sgt { binop(@_, "gt", 15) }
+sub pp_sge { binop(@_, "ge", 15) }
+sub pp_sle { binop(@_, "le", 15) }
+sub pp_scmp { binop(@_, "cmp", 14) }
+
+sub pp_sassign { binop(@_, "=", 7, SWAP_CHILDREN) }
+sub pp_aassign { binop(@_, "=", 7, SWAP_CHILDREN) }
+
+# `.' is special because concats-of-concats are optimized to save copying
+# by making all but the first concat stacked. The effect is as if the
+# programmer had written `($a . $b) .= $c', except legal.
+sub pp_concat {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my $left = $op->first;
+    my $right = $op->last;
+    my $eq = "";
+    my $prec = 18;
+    if ($op->flags & OPf_STACKED and $op->first->ppaddr ne "pp_concat") {
+	$eq = "=";
+	$prec = 7;
+    }
+    $left = $self->deparse_binop_left($op, $left, $prec);
+    $right = $self->deparse_binop_right($op, $right, $prec);
+    return $self->maybe_parens("$left .$eq $right", $cx, $prec);
+}
+
+# `x' is weird when the left arg is a list
+sub pp_repeat {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my $left = $op->first;
+    my $right = $op->last;
+    my $eq = "";
+    my $prec = 19;
+    if ($op->flags & OPf_STACKED) {
+	$eq = "=";
+	$prec = 7;
+    }
+    if (null($right)) { # list repeat; count is inside left-side ex-list
+	my $kid = $left->first->sibling; # skip pushmark
+	my @exprs;
+	for (; !null($kid->sibling); $kid = $kid->sibling) {
+	    push @exprs, $self->deparse($kid, 6);
+	}
+	$right = $kid;
+	$left = "(" . join(", ", @exprs). ")";
+    } else {
+	$left = $self->deparse_binop_left($op, $left, $prec);
+    }
+    $right = $self->deparse_binop_right($op, $right, $prec);
+    return $self->maybe_parens("$left x$eq $right", $cx, $prec);
+}
+
+sub range {
+    my $self = shift;
+    my ($op, $cx, $type) = @_;
+    my $left = $op->first;
+    my $right = $left->sibling;
+    $left = $self->deparse($left, 9);
+    $right = $self->deparse($right, 9);
+    return $self->maybe_parens("$left $type $right", $cx, 9);
+}
+
+sub pp_flop {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my $flip = $op->first;
+    my $type = ($flip->flags & OPf_SPECIAL) ? "..." : "..";
+    return $self->range($flip->first, $cx, $type);
+}
+
+# one-line while/until is handled in pp_leave
+
+sub logop {
+    my $self = shift;
+    my ($op, $cx, $lowop, $lowprec, $highop, $highprec, $blockname) = @_;
+    my $left = $op->first;
+    my $right = $op->first->sibling;
+    if ($cx == 0 and is_scope($right) and $blockname) { # if ($a) {$b}
+	$left = $self->deparse($left, 1);
+	$right = $self->deparse($right, 0);
+	return "$blockname ($left) {\n\t$right\n\b}\cK";
+    } elsif ($cx == 0 and $blockname and not $self->{'parens'}) { # $b if $a
+	$right = $self->deparse($right, 1);
+	$left = $self->deparse($left, 1);
+	return "$right $blockname $left";
+    } elsif ($cx > $lowprec and $highop) { # $a && $b
+	$left = $self->deparse_binop_left($op, $left, $highprec);
+	$right = $self->deparse_binop_right($op, $right, $highprec);
+	return $self->maybe_parens("$left $highop $right", $cx, $highprec);
+    } else { # $a and $b
+	$left = $self->deparse_binop_left($op, $left, $lowprec);
+	$right = $self->deparse_binop_right($op, $right, $lowprec);
+	return $self->maybe_parens("$left $lowop $right", $cx, $lowprec); 
+    }
+}
+
+sub pp_and { logop(@_, "and", 3, "&&", 11, "if") }
+sub pp_or {  logop(@_, "or",  2, "||", 10, "unless") }
+sub pp_xor { logop(@_, "xor", 2, "",   0,  "") }
+
+sub logassignop {
+    my $self = shift;
+    my ($op, $cx, $opname) = @_;
+    my $left = $op->first;
+    my $right = $op->first->sibling->first; # skip sassign
+    $left = $self->deparse($left, 7);
+    $right = $self->deparse($right, 7);
+    return $self->maybe_parens("$left $opname $right", $cx, 7);
+}
+
+sub pp_andassign { logassignop(@_, "&&=") }
+sub pp_orassign { logassignop(@_, "||=") }
+
+sub listop {
+    my $self = shift;
+    my($op, $cx, $name) = @_;
+    my(@exprs);
+    my $parens = ($cx >= 5) || $self->{'parens'};
+    my $kid = $op->first->sibling;
+    return $name if null $kid;
+    my $first = $self->deparse($kid, 6);
+    $first = "+$first" if not $parens and substr($first, 0, 1) eq "(";
+    push @exprs, $first;
+    $kid = $kid->sibling;
+    for (; !null($kid); $kid = $kid->sibling) {
+	push @exprs, $self->deparse($kid, 6);
+    }
+    if ($parens) {
+	return "$name(" . join(", ", @exprs) . ")";
+    } else {
+	return "$name " . join(", ", @exprs);
+    }
+}
+
+sub pp_bless { listop(@_, "bless") }
+sub pp_atan2 { listop(@_, "atan2") }
+sub pp_substr { maybe_local(@_, listop(@_, "substr")) }
+sub pp_vec { maybe_local(@_, listop(@_, "vec")) }
+sub pp_index { listop(@_, "index") }
+sub pp_rindex { listop(@_, "rindex") }
+sub pp_sprintf { listop(@_, "sprintf") }
+sub pp_formline { listop(@_, "formline") } # see also deparse_format
+sub pp_crypt { listop(@_, "crypt") }
+sub pp_unpack { listop(@_, "unpack") }
+sub pp_pack { listop(@_, "pack") }
+sub pp_join { listop(@_, "join") }
+sub pp_splice { listop(@_, "splice") }
+sub pp_push { listop(@_, "push") }
+sub pp_unshift { listop(@_, "unshift") }
+sub pp_reverse { listop(@_, "reverse") }
+sub pp_warn { listop(@_, "warn") }
+sub pp_die { listop(@_, "die") }
+# Actually, return is exempt from the LLAFR (see examples in this very
+# module!), but for consistency's sake, ignore that fact
+sub pp_return { listop(@_, "return") }
+sub pp_open { listop(@_, "open") }
+sub pp_pipe_op { listop(@_, "pipe") }
+sub pp_tie { listop(@_, "tie") }
+sub pp_dbmopen { listop(@_, "dbmopen") }
+sub pp_sselect { listop(@_, "select") }
+sub pp_select { listop(@_, "select") }
+sub pp_read { listop(@_, "read") }
+sub pp_sysopen { listop(@_, "sysopen") }
+sub pp_sysseek { listop(@_, "sysseek") }
+sub pp_sysread { listop(@_, "sysread") }
+sub pp_syswrite { listop(@_, "syswrite") }
+sub pp_send { listop(@_, "send") }
+sub pp_recv { listop(@_, "recv") }
+sub pp_seek { listop(@_, "seek") }
+sub pp_fcntl { listop(@_, "fcntl") }
+sub pp_ioctl { listop(@_, "ioctl") }
+sub pp_flock { listop(@_, "flock") }
+sub pp_socket { listop(@_, "socket") }
+sub pp_sockpair { listop(@_, "sockpair") }
+sub pp_bind { listop(@_, "bind") }
+sub pp_connect { listop(@_, "connect") }
+sub pp_listen { listop(@_, "listen") }
+sub pp_accept { listop(@_, "accept") }
+sub pp_shutdown { listop(@_, "shutdown") }
+sub pp_gsockopt { listop(@_, "getsockopt") }
+sub pp_ssockopt { listop(@_, "setsockopt") }
+sub pp_chown { listop(@_, "chown") }
+sub pp_unlink { listop(@_, "unlink") }
+sub pp_chmod { listop(@_, "chmod") }
+sub pp_utime { listop(@_, "utime") }
+sub pp_rename { listop(@_, "rename") }
+sub pp_link { listop(@_, "link") }
+sub pp_symlink { listop(@_, "symlink") }
+sub pp_mkdir { listop(@_, "mkdir") }
+sub pp_open_dir { listop(@_, "opendir") }
+sub pp_seekdir { listop(@_, "seekdir") }
+sub pp_waitpid { listop(@_, "waitpid") }
+sub pp_system { listop(@_, "system") }
+sub pp_exec { listop(@_, "exec") }
+sub pp_kill { listop(@_, "kill") }
+sub pp_setpgrp { listop(@_, "setpgrp") }
+sub pp_getpriority { listop(@_, "getpriority") }
+sub pp_setpriority { listop(@_, "setpriority") }
+sub pp_shmget { listop(@_, "shmget") }
+sub pp_shmctl { listop(@_, "shmctl") }
+sub pp_shmread { listop(@_, "shmread") }
+sub pp_shmwrite { listop(@_, "shmwrite") }
+sub pp_msgget { listop(@_, "msgget") }
+sub pp_msgctl { listop(@_, "msgctl") }
+sub pp_msgsnd { listop(@_, "msgsnd") }
+sub pp_msgrcv { listop(@_, "msgrcv") }
+sub pp_semget { listop(@_, "semget") }
+sub pp_semctl { listop(@_, "semctl") }
+sub pp_semop { listop(@_, "semop") }
+sub pp_ghbyaddr { listop(@_, "gethostbyaddr") }
+sub pp_gnbyaddr { listop(@_, "getnetbyaddr") }
+sub pp_gpbynumber { listop(@_, "getprotobynumber") }
+sub pp_gsbyname { listop(@_, "getservbyname") }
+sub pp_gsbyport { listop(@_, "getservbyport") }
+sub pp_syscall { listop(@_, "syscall") }
+
+sub pp_glob {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my $text = $self->dq($op->first->sibling);  # skip pushmark
+    if ($text =~ /^\$?(\w|::|\`)+$/ # could look like a readline
+	or $text =~ /[<>]/) { 
+	return 'glob(' . single_delim('qq', '"', $text) . ')';
+    } else {
+	return '<' . $text . '>';
+    }
+}
+
+# Truncate is special because OPf_SPECIAL makes a bareword first arg
+# be a filehandle. This could probably be better fixed in the core
+# by moving the GV lookup into ck_truc.
+
+sub pp_truncate {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my(@exprs);
+    my $parens = ($cx >= 5) || $self->{'parens'};
+    my $kid = $op->first->sibling;
+    my($fh, $len);
+    if ($op->flags & OPf_SPECIAL) {
+	# $kid is an OP_CONST
+	$fh = $kid->sv->PV;
+    } else {
+	$fh = $self->deparse($kid, 6);
+        $fh = "+$fh" if not $parens and substr($fh, 0, 1) eq "(";
+    }
+    my $len = $self->deparse($kid->sibling, 6);
+    if ($parens) {
+	return "truncate($fh, $len)";
+    } else {
+	return "truncate $fh, $len";
+    }
+
+}
+
+sub indirop {
+    my $self = shift;
+    my($op, $cx, $name) = @_;
+    my($expr, @exprs);
+    my $kid = $op->first->sibling;
+    my $indir = "";
+    if ($op->flags & OPf_STACKED) {
+	$indir = $kid;
+	$indir = $indir->first; # skip rv2gv
+	if (is_scope($indir)) {
+	    $indir = "{" . $self->deparse($indir, 0) . "}";
+	} else {
+	    $indir = $self->deparse($indir, 24);
+	}
+	$indir = $indir . " ";
+	$kid = $kid->sibling;
+    }
+    for (; !null($kid); $kid = $kid->sibling) {
+	$expr = $self->deparse($kid, 6);
+	push @exprs, $expr;
+    }
+    return $self->maybe_parens_func($name,
+				    $indir . join(", ", @exprs),
+				    $cx, 5);
+}
+
+sub pp_prtf { indirop(@_, "printf") }
+sub pp_print { indirop(@_, "print") }
+sub pp_sort { indirop(@_, "sort") }
+
+sub mapop {
+    my $self = shift;
+    my($op, $cx, $name) = @_;
+    my($expr, @exprs);
+    my $kid = $op->first; # this is the (map|grep)start
+    $kid = $kid->first->sibling; # skip a pushmark
+    my $code = $kid->first; # skip a null
+    if (is_scope $code) {
+	$code = "{" . $self->deparse($code, 1) . "} ";
+    } else {
+	$code = $self->deparse($code, 24) . ", ";
+    }
+    $kid = $kid->sibling;
+    for (; !null($kid); $kid = $kid->sibling) {
+	$expr = $self->deparse($kid, 6);
+	push @exprs, $expr if $expr;
+    }
+    return $self->maybe_parens_func($name, $code . join(", ", @exprs), $cx, 5);
+}
+
+sub pp_mapwhile { mapop(@_, "map") }   
+sub pp_grepwhile { mapop(@_, "grep") }   
+
+sub pp_list {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my($expr, @exprs);
+    my $kid = $op->first->sibling; # skip pushmark
+    my $lop;
+    my $local = "either"; # could be local(...) or my(...)
+    for ($lop = $kid; !null($lop); $lop = $lop->sibling) {
+	# This assumes that no other private flags equal 128, and that
+	# OPs that store things other than flags in their op_private,
+	# like OP_AELEMFAST, won't be immediate children of a list.
+	unless ($lop->private & OPp_LVAL_INTRO or $lop->ppaddr eq "pp_undef")
+	{
+	    $local = ""; # or not
+	    last;
+	}
+	if ($lop->ppaddr =~ /^pp_pad[ash]v$/) { # my()
+	    ($local = "", last) if $local eq "local";
+	    $local = "my";
+	} elsif ($lop->ppaddr ne "pp_undef") { # local()
+	    ($local = "", last) if $local eq "my";
+	    $local = "local";
+	}
+    }
+    $local = "" if $local eq "either"; # no point if it's all undefs
+    return $self->deparse($kid, $cx) if null $kid->sibling and not $local;
+    for (; !null($kid); $kid = $kid->sibling) {
+	if ($local) {
+	    if (class($kid) eq "UNOP" and $kid->first->ppaddr eq "pp_gvsv") {
+		$lop = $kid->first;
+	    } else {
+		$lop = $kid;
+	    }
+	    $self->{'avoid_local'}{$$lop}++;
+	    $expr = $self->deparse($kid, 6);
+	    delete $self->{'avoid_local'}{$$lop};
+	} else {
+	    $expr = $self->deparse($kid, 6);
+	}
+	push @exprs, $expr;
+    }
+    if ($local) {
+	return "$local(" . join(", ", @exprs) . ")";
+    } else {
+	return $self->maybe_parens( join(", ", @exprs), $cx, 6);	
+    }
+}
+
+sub pp_cond_expr {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my $cond = $op->first;
+    my $true = $cond->sibling;
+    my $false = $true->sibling;
+    my $cuddle = $self->{'cuddle'};
+    unless ($cx == 0 and is_scope($true) and is_scope($false)) {
+	$cond = $self->deparse($cond, 8);
+	$true = $self->deparse($true, 8);
+	$false = $self->deparse($false, 8);
+	return $self->maybe_parens("$cond ? $true : $false", $cx, 8);
+    } 
+    $cond = $self->deparse($cond, 1);
+    $true = $self->deparse($true, 0);    
+    if ($false->ppaddr eq "pp_lineseq") { # braces w/o scope => elsif
+	my $head = "if ($cond) {\n\t$true\n\b}";
+	my @elsifs;
+	while (!null($false) and $false->ppaddr eq "pp_lineseq") {
+	    my $newop = $false->first->sibling->first;
+	    my $newcond = $newop->first;
+	    my $newtrue = $newcond->sibling;
+	    $false = $newtrue->sibling; # last in chain is OP_AND => no else
+	    $newcond = $self->deparse($newcond, 1);
+	    $newtrue = $self->deparse($newtrue, 0);
+	    push @elsifs, "elsif ($newcond) {\n\t$newtrue\n\b}";
+	}
+	if (!null($false)) {	    
+	    $false = $cuddle . "else {\n\t" .
+	      $self->deparse($false, 0) . "\n\b}\cK";
+	} else {
+	    $false = "\cK";
+	}
+	return $head . join($cuddle, "", @elsifs) . $false; 
+    }
+    $false = $self->deparse($false, 0);
+    return "if ($cond) {\n\t$true\n\b}${cuddle}else {\n\t$false\n\b}\cK";
+}
+
+sub pp_leaveloop {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my $enter = $op->first;
+    my $kid = $enter->sibling;
+    local($self->{'curstash'}) = $self->{'curstash'};
+    my $head = "";
+    my $bare = 0;
+    if ($kid->ppaddr eq "pp_lineseq") { # bare or infinite loop 
+	if (is_state $kid->last) { # infinite
+	    $head = "for (;;) "; # shorter than while (1)
+	} else {
+	    $bare = 1;
+	}
+    } elsif ($enter->ppaddr eq "pp_enteriter") { # foreach
+	my $ary = $enter->first->sibling; # first was pushmark
+	my $var = $ary->sibling;
+	if ($enter->flags & OPf_STACKED
+	    and not null $ary->first->sibling->sibling)
+	{
+	    $ary = $self->deparse($ary->first->sibling, 9) . " .. " .
+	      $self->deparse($ary->first->sibling->sibling, 9);
+	} else {
+	    $ary = $self->deparse($ary, 1);
+	}
+	if (null $var) {
+	    if ($enter->flags & OPf_SPECIAL) { # thread special var
+		$var = $self->pp_threadsv($enter, 1);
+	    } else { # regular my() variable
+		$var = $self->pp_padsv($enter, 1);
+		if ($self->padname_sv($enter->targ)->IVX ==
+		    $kid->first->first->sibling->last->cop_seq)
+		{
+		    # If the scope of this variable closes at the last
+		    # statement of the loop, it must have been
+		    # declared here.
+		    $var = "my " . $var;
+		}
+	    }
+	} elsif ($var->ppaddr eq "pp_rv2gv") {
+	    $var = $self->pp_rv2sv($var, 1);
+	} elsif ($var->ppaddr eq "pp_gv") {
+	    $var = "\$" . $self->deparse($var, 1);
+	}
+	$head = "foreach $var ($ary) ";
+	$kid = $kid->first->first->sibling; # skip OP_AND and OP_ITER
+    } elsif ($kid->ppaddr eq "pp_null") { # while/until
+	$kid = $kid->first;
+	my $name = {"pp_and" => "while", "pp_or" => "until"}
+	            ->{$kid->ppaddr};
+	$head = "$name (" . $self->deparse($kid->first, 1) . ") ";
+	$kid = $kid->first->sibling;
+    } elsif ($kid->ppaddr eq "pp_stub") { # bare and empty
+	return "{;}"; # {} could be a hashref
+    }
+    # The third-to-last kid is the continue block if the pointer used
+    # by `next BLOCK' points to its first OP, which happens to be the
+    # the op_next of the head of the _previous_ statement. 
+    # Unless it's a bare loop, in which case it's last, since there's
+    # no unstack or extra nextstate.
+    # Except if the previous head isn't null but the first kid is
+    # (because it's a nulled out nextstate in a scope), in which
+    # case the head's next is advanced past the null but the nextop's
+    # isn't, so we need to try nextop->next.
+    my($cont, $precont);
+    if ($bare) {
+	$cont = $kid->first;
+	while (!null($cont->sibling)) {
+	    $precont = $cont;
+	    $cont = $cont->sibling;
+	}	
+    } else {
+	$cont = $kid->first;
+	while (!null($cont->sibling->sibling->sibling)) {
+	    $precont = $cont;
+	    $cont = $cont->sibling;
+	}
+    }
+    if ($precont and $ {$precont->next} == $ {$enter->nextop}
+	|| $ {$precont->next} == $ {$enter->nextop->next} )
+    {
+       my $state = $kid->first;
+       my $cuddle = $self->{'cuddle'};
+       my($expr, @exprs);
+       for (; $$state != $$cont; $state = $state->sibling) {
+	   $expr = "";
+	   if (is_state $state) {
+	       $expr = $self->deparse($state, 0);
+	       $state = $state->sibling;
+	       last if null $kid;
+	   }
+	   $expr .= $self->deparse($state, 0);
+	   push @exprs, $expr if $expr;
+       }
+       $kid = join(";\n", @exprs);
+       $cont = $cuddle . "continue {\n\t" .
+	 $self->deparse($cont, 0) . "\n\b}\cK";
+    } else {
+	$cont = "\cK";
+	$kid = $self->deparse($kid, 0);
+    }
+    return $head . "{\n\t" . $kid . "\n\b}" . $cont;
+}
+
+sub pp_leavetry {
+    my $self = shift;
+    return "eval {\n\t" . $self->pp_leave(@_) . "\n\b}";
+}
+
+sub OP_CONST () { 5 }
+
+# XXX need a better way to do this
+sub OP_STRINGIFY () { $] > 5.004_72 ? 67 : 65 }
+
+sub pp_null {
+    my $self = shift;
+    my($op, $cx) = @_;
+    if (class($op) eq "OP") {
+	return "'???'" if $op->targ == OP_CONST; # old value is lost
+    } elsif ($op->first->ppaddr eq "pp_pushmark") {
+	return $self->pp_list($op, $cx);
+    } elsif ($op->first->ppaddr eq "pp_enter") {
+	return $self->pp_leave($op, $cx);
+    } elsif ($op->targ == OP_STRINGIFY) {
+	return $self->dquote($op);
+    } elsif (!null($op->first->sibling) and
+	     $op->first->sibling->ppaddr eq "pp_readline" and
+	     $op->first->sibling->flags & OPf_STACKED) {
+	return $self->maybe_parens($self->deparse($op->first, 7) . " = "
+				   . $self->deparse($op->first->sibling, 7),
+				   $cx, 7);
+    } elsif (!null($op->first->sibling) and
+	     $op->first->sibling->ppaddr eq "pp_trans" and
+	     $op->first->sibling->flags & OPf_STACKED) {
+	return $self->maybe_parens($self->deparse($op->first, 20) . " =~ "
+				   . $self->deparse($op->first->sibling, 20),
+				   $cx, 20);
+    } else {
+	return $self->deparse($op->first, $cx);
+    }
+}
+
+sub padname {
+    my $self = shift;
+    my $targ = shift;
+    my $str = $self->padname_sv($targ)->PV;
+    return padname_fix($str);
+}
+
+sub padany {
+    my $self = shift;
+    my $op = shift;
+    return substr($self->padname($op->targ), 1); # skip $/@/%
+}
+
+sub pp_padsv {
+    my $self = shift;
+    my($op, $cx) = @_;
+    return $self->maybe_my($op, $cx, $self->padname($op->targ));
+}
+
+sub pp_padav { pp_padsv(@_) }
+sub pp_padhv { pp_padsv(@_) }
+
+my @threadsv_names;
+
+BEGIN {
+    @threadsv_names = ("_", "1", "2", "3", "4", "5", "6", "7", "8", "9",
+		       "&", "`", "'", "+", "/", ".", ",", "\\", '"', ";",
+		       "^", "-", "%", "=", "|", "~", ":", "^A", "^E",
+		       "!", "@");
+}
+
+sub pp_threadsv {
+    my $self = shift;
+    my($op, $cx) = @_;
+    return $self->maybe_local($op, $cx, "\$" .  $threadsv_names[$op->targ]);
+}    
+
+sub pp_gvsv {
+    my $self = shift;
+    my($op, $cx) = @_;
+    return $self->maybe_local($op, $cx, "\$" . $self->gv_name($op->gv));
+}
+
+sub pp_gv {
+    my $self = shift;
+    my($op, $cx) = @_;
+    return $self->gv_name($op->gv);
+}
+
+sub pp_aelemfast {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my $gv = $op->gv;
+    return "\$" . $self->gv_name($gv) . "[" . $op->private . "]";
+}
+
+sub rv2x {
+    my $self = shift;
+    my($op, $cx, $type) = @_;
+    my $kid = $op->first;
+    my $str = $self->deparse($kid, 0);
+    return $type . (is_scalar($kid) ? $str : "{$str}");
+}
+
+sub pp_rv2sv { maybe_local(@_, rv2x(@_, "\$")) }
+sub pp_rv2hv { maybe_local(@_, rv2x(@_, "%")) }
+sub pp_rv2gv { maybe_local(@_, rv2x(@_, "*")) }
+
+# skip rv2av
+sub pp_av2arylen {
+    my $self = shift;
+    my($op, $cx) = @_;
+    if ($op->first->ppaddr eq "pp_padav") {
+	return $self->maybe_local($op, $cx, '$#' . $self->padany($op->first));
+    } else {
+	return $self->maybe_local($op, $cx,
+				  $self->rv2x($op->first, $cx, '$#'));
+    }
+}
+
+# skip down to the old, ex-rv2cv
+sub pp_rv2cv { $_[0]->rv2x($_[1]->first->first->sibling, $_[2], "&") }
+
+sub pp_rv2av {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my $kid = $op->first;
+    if ($kid->ppaddr eq "pp_const") { # constant list
+	my $av = $kid->sv;
+	return "(" . join(", ", map(const($_), $av->ARRAY)) . ")";
+    } else {
+	return $self->maybe_local($op, $cx, $self->rv2x($op, $cx, "\@"));
+    }
+ }
+
+
+sub elem {
+    my $self = shift;
+    my ($op, $cx, $left, $right, $padname) = @_;
+    my($array, $idx) = ($op->first, $op->first->sibling);
+    unless ($array->ppaddr eq $padname) { # Maybe this has been fixed	
+	$array = $array->first; # skip rv2av (or ex-rv2av in _53+)
+    }
+    if ($array->ppaddr eq $padname) {
+	$array = $self->padany($array);
+    } elsif (is_scope($array)) { # ${expr}[0]
+	$array = "{" . $self->deparse($array, 0) . "}";
+    } elsif (is_scalar $array) { # $x[0], $$x[0], ...
+	$array = $self->deparse($array, 24);
+    } else {
+	# $x[20][3]{hi} or expr->[20]
+	my $arrow;
+	$arrow = "->" if $array->ppaddr !~ /^pp_[ah]elem$/;
+	return $self->deparse($array, 24) . $arrow .
+	    $left . $self->deparse($idx, 1) . $right;
+    }
+    $idx = $self->deparse($idx, 1);
+    return "\$" . $array . $left . $idx . $right;
+}
+
+sub pp_aelem { maybe_local(@_, elem(@_, "[", "]", "pp_padav")) }
+sub pp_helem { maybe_local(@_, elem(@_, "{", "}", "pp_padhv")) }
+
+sub pp_gelem {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my($glob, $part) = ($op->first, $op->last);
+    $glob = $glob->first; # skip rv2gv
+    $glob = $glob->first if $glob->ppaddr eq "pp_rv2gv"; # this one's a bug
+    my $scope = is_scope($glob);
+    $glob = $self->deparse($glob, 0);
+    $part = $self->deparse($part, 1);
+    return "*" . ($scope ? "{$glob}" : $glob) . "{$part}";
+}
+
+sub slice {
+    my $self = shift;
+    my ($op, $cx, $left, $right, $regname, $padname) = @_;
+    my $last;
+    my(@elems, $kid, $array, $list);
+    if (class($op) eq "LISTOP") {
+	$last = $op->last;
+    } else { # ex-hslice inside delete()
+	for ($kid = $op->first; !null $kid->sibling; $kid = $kid->sibling) {}
+	$last = $kid;
+    }
+    $array = $last;
+    $array = $array->first
+	if $array->ppaddr eq $regname or $array->ppaddr eq "pp_null";
+    if (is_scope($array)) {
+	$array = "{" . $self->deparse($array, 0) . "}";
+    } elsif ($array->ppaddr eq $padname) {
+	$array = $self->padany($array);
+    } else {
+	$array = $self->deparse($array, 24);
+    }
+    $kid = $op->first->sibling; # skip pushmark
+    if ($kid->ppaddr eq "pp_list") {
+	$kid = $kid->first->sibling; # skip list, pushmark
+	for (; !null $kid; $kid = $kid->sibling) {
+	    push @elems, $self->deparse($kid, 6);
+	}
+	$list = join(", ", @elems);
+    } else {
+	$list = $self->deparse($kid, 1);
+    }
+    return "\@" . $array . $left . $list . $right;
+}
+
+sub pp_aslice { maybe_local(@_, slice(@_, "[", "]", 
+				      "pp_rv2av", "pp_padav")) }
+sub pp_hslice { maybe_local(@_, slice(@_, "{", "}",
+				      "pp_rv2hv", "pp_padhv")) }
+
+sub pp_lslice {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my $idx = $op->first;
+    my $list = $op->last;
+    my(@elems, $kid);
+    $list = $self->deparse($list, 1);
+    $idx = $self->deparse($idx, 1);
+    return "($list)" . "[$idx]";
+}
+
+sub OPpENTERSUB_AMPER () { 8 }
+
+sub OPf_WANT () { 3 }
+sub OPf_WANT_VOID () { 1 }
+sub OPf_WANT_SCALAR () { 2 }
+sub OPf_WANT_LIST () { 2 }
+
+sub want_scalar {
+    my $op = shift;
+    return ($op->flags & OPf_WANT) == OPf_WANT_SCALAR;
+}
+
+sub pp_entersub {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my $prefix = "";
+    my $amper = "";
+    my $proto = undef;
+    my $simple = 0;
+    my($kid, $args, @exprs);
+    if (not null $op->first->sibling) { # method
+	$kid = $op->first->sibling; # skip pushmark
+	my $obj = $self->deparse($kid, 24);
+	$kid = $kid->sibling;
+	for (; not null $kid->sibling; $kid = $kid->sibling) {
+	    push @exprs, $self->deparse($kid, 6);
+	}
+	my $meth = $kid->first;
+	if ($meth->ppaddr eq "pp_const") {
+	    $meth = $meth->sv->PV; # needs to be bare
+	} else {
+	    $meth = $self->deparse($meth, 1);
+	}
+	$args = join(", ", @exprs);	
+	$kid = $obj . "->" . $meth;
+	if ($args) {
+	    return $kid . "(" . $args . ")"; # parens mandatory
+	} else {
+	    return $kid; # toke.c fakes parens
+	}
+    }
+    # else, not a method
+    if ($op->flags & OPf_SPECIAL) {
+	$prefix = "do ";
+    } elsif ($op->private & OPpENTERSUB_AMPER) {
+	$amper = "&";
+    }
+    $kid = $op->first;
+    $kid = $kid->first->sibling; # skip ex-list, pushmark
+    for (; not null $kid->sibling; $kid = $kid->sibling) {
+	push @exprs, $kid;
+    }
+    if (is_scope($kid)) {
+	$amper = "&";
+	$kid = "{" . $self->deparse($kid, 0) . "}";
+    } elsif ($kid->first->ppaddr eq "pp_gv") {
+	my $gv = $kid->first->gv;
+	if (class($gv->CV) ne "SPECIAL") {
+	    $proto = $gv->CV->PV if $gv->CV->FLAGS & SVf_POK;
+	}
+	$simple = 1;
+	$kid = $self->deparse($kid, 24);
+    } elsif (is_scalar $kid->first) {
+	$amper = "&";
+	$kid = $self->deparse($kid, 24);
+    } else {
+	$prefix = "";
+	$kid = $self->deparse($kid, 24) . "->";
+    }
+    if (defined $proto and not $amper) {
+	my($arg, $real);
+	my $doneok = 0;
+	my @args = @exprs;
+	my @reals;
+	my $p = $proto;
+	$p =~ s/([^\\]|^)([@%])(.*)$/$1$2/;
+	while ($p) {
+	    $p =~ s/^ *([\\]?[\$\@&%*]|;)//;
+	    my $chr = $1;
+	    if ($chr eq "") {
+		undef $proto if @args;
+	    } elsif ($chr eq ";") {
+		$doneok = 1;
+	    } elsif ($chr eq "@" or $chr eq "%") {
+		push @reals, map($self->deparse($_, 6), @args);
+		@args = ();
+	    } else {
+		$arg = shift @args;
+		last unless $arg;
+		if ($chr eq "\$") {
+		    if (want_scalar $arg) {
+			push @reals, $self->deparse($arg, 6);
+		    } else {
+			undef $proto;
+		    }
+		} elsif ($chr eq "&") {
+		    if ($arg->ppaddr =~ /pp_(s?refgen|undef)/) {
+			push @reals, $self->deparse($arg, 6);
+		    } else {
+			undef $proto;
+		    }
+		} elsif ($chr eq "*") {
+		    if ($arg->ppaddr =~ /^pp_s?refgen$/
+			and $arg->first->first->ppaddr eq "pp_rv2gv")
+		    {
+			$real = $arg->first->first; # skip refgen, null
+			if ($real->first->ppaddr eq "pp_gv") {
+			    push @reals, $self->deparse($real, 6);
+			} else {
+			    push @reals, $self->deparse($real->first, 6);
+			}
+		    } else {
+			undef $proto;
+		    }
+		} elsif (substr($chr, 0, 1) eq "\\") {
+		    $chr = substr($chr, 1);
+		    if ($arg->ppaddr =~ /^pp_s?refgen$/ and
+			!null($real = $arg->first) and
+			($chr eq "\$" && is_scalar($real->first)
+			 or ($chr eq "\@"
+			     && $real->first->sibling->ppaddr 
+			     =~ /^pp_(rv2|pad)av$/)
+			 or ($chr eq "%"
+			     && $real->first->sibling->ppaddr
+			     =~ /^pp_(rv2|pad)hv$/)
+			 #or ($chr eq "&" # This doesn't work
+			 #   && $real->first->ppaddr eq "pp_rv2cv")
+			 or ($chr eq "*"
+			     && $real->first->ppaddr eq "pp_rv2gv")))
+		    {
+			push @reals, $self->deparse($real, 6);
+		    } else {
+			undef $proto;
+		    }
+		}
+	    }
+	}
+	undef $proto if $p and !$doneok;
+	undef $proto if @args;
+	$args = join(", ", @reals);
+	$amper = "";
+	unless (defined $proto) {
+	    $amper = "&";
+	    $args = join(", ", map($self->deparse($_, 6), @exprs));
+	}
+    } else {
+	$args = join(", ", map($self->deparse($_, 6), @exprs));
+    }
+    if ($prefix or $amper) {
+	if ($op->flags & OPf_STACKED) {
+	    return $prefix . $amper . $kid . "(" . $args . ")";
+	} else {
+	    return $prefix . $amper. $kid;
+	}
+    } else {
+	if (defined $proto and $proto eq "") {
+	    return $kid;
+	} elsif ($proto eq "\$") {
+	    return $self->maybe_parens_func($kid, $args, $cx, 16);
+	} elsif ($proto or $simple) {
+	    return $self->maybe_parens_func($kid, $args, $cx, 5);
+	} else {
+	    return "$kid(" . $args . ")";
+	}
+    }
+}
+
+sub pp_enterwrite { unop(@_, "write") }
+
+# escape things that cause interpolation in double quotes,
+# but not character escapes
+sub uninterp {
+    my($str) = @_;
+    $str =~ s/(^|[^\\])([\$\@]|\\[uUlLQE])/$1\\$2/g;
+    return $str;
+}
+
+# the same, but treat $|, $), and $ at the end of the string differently
+sub re_uninterp {
+    my($str) = @_;
+    $str =~ s/(^|[^\\])(\@|\\[uUlLQE])/$1\\$2/g;
+    $str =~ s/(^|[^\\])(\$[^)|])/$1\\$2/g;
+    return $str;
+}
+
+# character escapes, but not delimiters that might need to be escaped
+sub escape_str { # ASCII
+    my($str) = @_;
+    $str =~ s/\a/\\a/g;
+#    $str =~ s/\cH/\\b/g; # \b means someting different in a regex 
+    $str =~ s/\t/\\t/g;
+    $str =~ s/\n/\\n/g;
+    $str =~ s/\e/\\e/g;
+    $str =~ s/\f/\\f/g;
+    $str =~ s/\r/\\r/g;
+    $str =~ s/([\cA-\cZ])/'\\c' . chr(ord('@') + ord($1))/ge;
+    $str =~ s/([\0\033-\037\177-\377])/'\\' . sprintf("%03o", ord($1))/ge;
+    return $str;
+}
+
+# Don't do this for regexen
+sub unback {
+    my($str) = @_;
+    $str =~ s/\\/\\\\/g;
+    return $str;
+}
+
+sub balanced_delim {
+    my($str) = @_;
+    my @str = split //, $str;
+    my($ar, $open, $close, $fail, $c, $cnt);
+    for $ar (['[',']'], ['(',')'], ['<','>'], ['{','}']) {
+	($open, $close) = @$ar;
+	$fail = 0; $cnt = 0;
+	for $c (@str) {
+	    if ($c eq $open) {
+		$cnt++;
+	    } elsif ($c eq $close) {
+		$cnt--;
+		if ($cnt < 0) {
+		    $fail = 1;
+		    last;
+		}
+	    }
+	}
+	$fail = 1 if $cnt != 0;
+	return ($open, "$open$str$close") if not $fail;
+    }
+    return ("", $str);
+}
+
+sub single_delim {
+    my($q, $default, $str) = @_;
+    return "$default$str$default" if $default and index($str, $default) == -1;
+    my($succeed, $delim);
+    ($succeed, $str) = balanced_delim($str);
+    return "$q$str" if $succeed;
+    for $delim ('/', '"', '#') {
+	return "$q$delim" . $str . $delim if index($str, $delim) == -1;
+    }
+    if ($default) {
+	$str =~ s/$default/\\$default/g;
+	return "$default$str$default";
+    } else {
+	$str =~ s[/][\\/]g;
+	return "$q/$str/";
+    }
+}
+
+sub SVf_IOK () {0x10000}
+sub SVf_NOK () {0x20000}
+sub SVf_ROK () {0x80000}
+
+sub const {
+    my $sv = shift;
+    if (class($sv) eq "SPECIAL") {
+	return ('undef', '1', '0')[$$sv-1];
+    } elsif ($sv->FLAGS & SVf_IOK) {
+	return $sv->IV;
+    } elsif ($sv->FLAGS & SVf_NOK) {
+	return $sv->NV;
+    } elsif ($sv->FLAGS & SVf_ROK) {
+	return "\\(" . const($sv->RV) . ")"; # constant folded
+    } else {
+	my $str = $sv->PV;
+	if ($str =~ /[^ -~]/) { # ASCII
+	    return single_delim("qq", '"', uninterp escape_str unback $str);
+	} else {
+	    $str =~ s/\\/\\\\/g;
+	    return single_delim("q", "'", $str);
+	}
+    }
+}
+
+sub pp_const {
+    my $self = shift;
+    my($op, $cx) = @_;
+#    if ($op->private & OPp_CONST_BARE) { # trouble with `=>' autoquoting 
+#	return $op->sv->PV;
+#    }
+    return const($op->sv);
+}
+
+sub dq {
+    my $self = shift;
+    my $op = shift;
+    my $type = $op->ppaddr;
+    if ($type eq "pp_const") {
+	return uninterp(escape_str(unback($op->sv->PV)));
+    } elsif ($type eq "pp_concat") {
+	return $self->dq($op->first) . $self->dq($op->last);
+    } elsif ($type eq "pp_uc") {
+	return '\U' . $self->dq($op->first->sibling) . '\E';
+    } elsif ($type eq "pp_lc") {
+	return '\L' . $self->dq($op->first->sibling) . '\E';
+    } elsif ($type eq "pp_ucfirst") {
+	return '\u' . $self->dq($op->first->sibling);
+    } elsif ($type eq "pp_lcfirst") {
+	return '\l' . $self->dq($op->first->sibling);
+    } elsif ($type eq "pp_quotemeta") {
+	return '\Q' . $self->dq($op->first->sibling) . '\E';
+    } elsif ($type eq "pp_join") {
+	return $self->deparse($op->last, 26); # was join($", @ary)
+    } else {
+	return $self->deparse($op, 26);
+    }
+}
+
+sub pp_backtick {
+    my $self = shift;
+    my($op, $cx) = @_;
+    # skip pushmark
+    return single_delim("qx", '`', $self->dq($op->first->sibling));
+}
+
+sub dquote {
+    my $self = shift;
+    my $op = shift;
+    # skip ex-stringify, pushmark
+    return single_delim("qq", '"', $self->dq($op->first->sibling)); 
+}
+
+# OP_STRINGIFY is a listop, but it only ever has one arg (?)
+sub pp_stringify { dquote(@_) }
+
+# tr/// and s/// (and tr[][], tr[]//, tr###, etc)
+# note that tr(from)/to/ is OK, but not tr/from/(to)
+sub double_delim {
+    my($from, $to) = @_;
+    my($succeed, $delim);
+    if ($from !~ m[/] and $to !~ m[/]) {
+	return "/$from/$to/";
+    } elsif (($succeed, $from) = balanced_delim($from) and $succeed) {
+	if (($succeed, $to) = balanced_delim($to) and $succeed) {
+	    return "$from$to";
+	} else {
+	    for $delim ('/', '"', '#') { # note no `'' -- s''' is special
+		return "$from$delim$to$delim" if index($to, $delim) == -1;
+	    }
+	    $to =~ s[/][\\/]g;
+	    return "$from/$to/";
+	}
+    } else {
+	for $delim ('/', '"', '#') { # note no '
+	    return "$delim$from$delim$to$delim"
+		if index($to . $from, $delim) == -1;
+	}
+	$from =~ s[/][\\/]g;
+	$to =~ s[/][\\/]g;
+	return "/$from/$to/";	
+    }
+}
+
+sub pchr { # ASCII
+    my($n) = @_;
+    if ($n == ord '\\') {
+	return '\\\\';
+    } elsif ($n >= ord(' ') and $n <= ord('~')) {
+	return chr($n);
+    } elsif ($n == ord "\a") {
+	return '\\a';
+    } elsif ($n == ord "\b") {
+	return '\\b';
+    } elsif ($n == ord "\t") {
+	return '\\t';
+    } elsif ($n == ord "\n") {
+	return '\\n';
+    } elsif ($n == ord "\e") {
+	return '\\e';
+    } elsif ($n == ord "\f") {
+	return '\\f';
+    } elsif ($n == ord "\r") {
+	return '\\r';
+    } elsif ($n >= ord("\cA") and $n <= ord("\cZ")) {
+	return '\\c' . chr(ord("@") + $n);
+    } else {
+#	return '\x' . sprintf("%02x", $n);
+	return '\\' . sprintf("%03o", $n);
+    }
+}
+
+sub collapse {
+    my(@chars) = @_;
+    my($c, $str, $tr);
+    for ($c = 0; $c < @chars; $c++) {
+	$tr = $chars[$c];
+	$str .= pchr($tr);
+	if ($c <= $#chars - 2 and $chars[$c + 1] == $tr + 1 and
+	    $chars[$c + 2] == $tr + 2)
+	{
+	    for (; $c <= $#chars and $chars[$c + 1] == $chars[$c] + 1; $c++) {}
+	    $str .= "-";
+	    $str .= pchr($chars[$c]);
+	}
+    }
+    return $str;
+}
+
+sub OPpTRANS_SQUASH () { 16 }
+sub OPpTRANS_DELETE () { 32 }
+sub OPpTRANS_COMPLEMENT () { 64 }
+
+sub pp_trans {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my(@table) = unpack("s256", $op->pv);
+    my($c, $tr, @from, @to, @delfrom, $delhyphen);
+    if ($table[ord "-"] != -1 and 
+	$table[ord("-") - 1] == -1 || $table[ord("-") + 1] == -1)
+    {
+	$tr = $table[ord "-"];
+	$table[ord "-"] = -1;
+	if ($tr >= 0) {
+	    @from = ord("-");
+	    @to = $tr;
+	} else { # -2 ==> delete
+	    $delhyphen = 1;
+	}
+    }
+    for ($c = 0; $c < 256; $c++) {
+	$tr = $table[$c];
+	if ($tr >= 0) {
+	    push @from, $c; push @to, $tr;
+	} elsif ($tr == -2) {
+	    push @delfrom, $c;
+	}
+    }
+    my $flags;
+    @from = (@from, @delfrom);
+    if ($op->private & OPpTRANS_COMPLEMENT) {
+	$flags .= "c";
+	my @newfrom = ();
+	my %from;
+	@from{@from} = (1) x @from;
+	for ($c = 0; $c < 256; $c++) {
+	    push @newfrom, $c unless $from{$c};
+	}
+	@from = @newfrom;
+    }
+    if ($op->private & OPpTRANS_DELETE) {
+	$flags .= "d";
+    } else {
+	pop @to while $#to and $to[$#to] == $to[$#to -1];
+    }
+    $flags .= "s" if $op->private & OPpTRANS_SQUASH;
+    my($from, $to);
+    $from = collapse(@from);
+    $to = collapse(@to);
+    $from .= "-" if $delhyphen;
+    return "tr" . double_delim($from, $to) . $flags;
+}
+
+# Like dq(), but different
+sub re_dq {
+    my $self = shift;
+    my $op = shift;
+    my $type = $op->ppaddr;
+    if ($type eq "pp_const") {
+	return uninterp($op->sv->PV);
+    } elsif ($type eq "pp_concat") {
+	return $self->re_dq($op->first) . $self->re_dq($op->last);
+    } elsif ($type eq "pp_uc") {
+	return '\U' . $self->re_dq($op->first->sibling) . '\E';
+    } elsif ($type eq "pp_lc") {
+	return '\L' . $self->re_dq($op->first->sibling) . '\E';
+    } elsif ($type eq "pp_ucfirst") {
+	return '\u' . $self->re_dq($op->first->sibling);
+    } elsif ($type eq "pp_lcfirst") {
+	return '\l' . $self->re_dq($op->first->sibling);
+    } elsif ($type eq "pp_quotemeta") {
+	return '\Q' . $self->re_dq($op->first->sibling) . '\E';
+    } elsif ($type eq "pp_join") {
+	return $self->deparse($op->last, 26); # was join($", @ary)
+    } else {
+	return $self->deparse($op, 26);
+    }
+}
+
+sub pp_regcomp {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my $kid = $op->first;
+    $kid = $kid->first if $kid->ppaddr eq "pp_regcmaybe";
+    $kid = $kid->first if $kid->ppaddr eq "pp_regcreset";
+    return $self->re_dq($kid);
+}
+
+sub OPp_RUNTIME () { 64 }
+
+sub PMf_ONCE () { 0x2 }
+sub PMf_SKIPWHITE () { 0x10 }
+sub PMf_CONST () { 0x40 }
+sub PMf_KEEP () { 0x80 }
+sub PMf_GLOBAL () { 0x100 }
+sub PMf_CONTINUE () { 0x200 }
+sub PMf_EVAL () { 0x400 }
+sub PMf_LOCALE () { 0x800 }
+sub PMf_MULTILINE () { 0x1000 }
+sub PMf_SINGLELINE () { 0x2000 }
+sub PMf_FOLD () { 0x4000 }
+sub PMf_EXTENDED () { 0x8000 }
+
+# osmic acid -- see osmium tetroxide
+
+my %matchwords;
+map($matchwords{join "", sort split //, $_} = $_, 'cig', 'cog', 'cos', 'cogs',
+    'cox', 'go', 'is', 'ism', 'iso', 'mig', 'mix', 'osmic', 'ox', 'sic', 
+    'sig', 'six', 'smog', 'so', 'soc', 'sog', 'xi'); 
+
+sub matchop {
+    my $self = shift;
+    my($op, $cx, $name, $delim) = @_;
+    my $kid = $op->first;
+    my ($binop, $var, $re) = ("", "", "");
+    if ($op->flags & OPf_STACKED) {
+	$binop = 1;
+	$var = $self->deparse($kid, 20);
+	$kid = $kid->sibling;
+    }
+    if (null $kid) {
+	$re = re_uninterp(escape_str($op->precomp));
+    } else {
+	$re = $self->deparse($kid, 1);
+    }
+    my $flags = "";
+    $flags .= "c" if $op->pmflags & PMf_CONTINUE;
+    $flags .= "g" if $op->pmflags & PMf_GLOBAL;
+    $flags .= "i" if $op->pmflags & PMf_FOLD;
+    $flags .= "m" if $op->pmflags & PMf_MULTILINE;
+    $flags .= "o" if $op->pmflags & PMf_KEEP;
+    $flags .= "s" if $op->pmflags & PMf_SINGLELINE;
+    $flags .= "x" if $op->pmflags & PMf_EXTENDED;
+    $flags = $matchwords{$flags} if $matchwords{$flags};
+    if ($op->pmflags & PMf_ONCE) { # only one kind of delimiter works here
+	$re =~ s/\?/\\?/g;
+	$re = "?$re?";
+    } else {
+	$re = single_delim($name, $delim, $re);
+    }
+    $re = $re . $flags;
+    if ($binop) {
+	return $self->maybe_parens("$var =~ $re", $cx, 20);
+    } else {
+	return $re;
+    }
+}
+
+sub pp_match { matchop(@_, "m", "/") }
+sub pp_pushre { matchop(@_, "m", "/") }
+sub pp_qr { matchop(@_, "qr", "") }
+
+sub pp_split {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my($kid, @exprs, $ary, $expr);
+    $kid = $op->first;
+    if ($ {$kid->pmreplroot}) {
+	$ary = '@' . $self->gv_name($kid->pmreplroot);
+    }
+    for (; !null($kid); $kid = $kid->sibling) {
+	push @exprs, $self->deparse($kid, 6);
+    }
+    $expr = "split(" . join(", ", @exprs) . ")";
+    if ($ary) {
+	return $self->maybe_parens("$ary = $expr", $cx, 7);
+    } else {
+	return $expr;
+    }
+}
+
+# oxime -- any of various compounds obtained chiefly by the action of
+# hydroxylamine on aldehydes and ketones and characterized by the
+# bivalent grouping C=NOH [Webster's Tenth]
+
+my %substwords;
+map($substwords{join "", sort split //, $_} = $_, 'ego', 'egoism', 'em',
+    'es', 'ex', 'exes', 'gee', 'go', 'goes', 'ie', 'ism', 'iso', 'me',
+    'meese', 'meso', 'mig', 'mix', 'os', 'ox', 'oxime', 'see', 'seem',
+    'seg', 'sex', 'sig', 'six', 'smog', 'sog', 'some', 'xi');
+
+sub pp_subst {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my $kid = $op->first;
+    my($binop, $var, $re, $repl) = ("", "", "", "");
+    if ($op->flags & OPf_STACKED) {
+	$binop = 1;
+	$var = $self->deparse($kid, 20);
+	$kid = $kid->sibling;
+    }
+    my $flags = "";    
+    if (null($op->pmreplroot)) {
+	$repl = $self->dq($kid);
+	$kid = $kid->sibling;
+    } else {
+	$repl = $op->pmreplroot->first; # skip substcont
+	while ($repl->ppaddr eq "pp_entereval") {
+	    $repl = $repl->first;
+	    $flags .= "e";
+	}
+	$repl = $self->dq($repl);
+    }
+    if (null $kid) {
+	$re = re_uninterp(escape_str($op->precomp));
+    } else {
+	$re = $self->deparse($kid, 1);
+    }
+    $flags .= "e" if $op->pmflags & PMf_EVAL;
+    $flags .= "g" if $op->pmflags & PMf_GLOBAL;
+    $flags .= "i" if $op->pmflags & PMf_FOLD;
+    $flags .= "m" if $op->pmflags & PMf_MULTILINE;
+    $flags .= "o" if $op->pmflags & PMf_KEEP;
+    $flags .= "s" if $op->pmflags & PMf_SINGLELINE;
+    $flags .= "x" if $op->pmflags & PMf_EXTENDED;
+    $flags = $substwords{$flags} if $substwords{$flags};
+    if ($binop) {
+	return $self->maybe_parens("$var =~ s"
+				   . double_delim($re, $repl) . $flags,
+				   $cx, 20);
+    } else {
+	return "s". double_delim($re, $repl) . $flags;	
+    }
+}
+
+1;
+__END__
+
+=head1 NAME
+
+B::Deparse - Perl compiler backend to produce perl code
+
+=head1 SYNOPSIS
+
+B<perl> B<-MO=Deparse>[B<,-u>I<PACKAGE>][B<,-p>][B<,-l>][B<,-s>I<LETTERS>] I<prog.pl>
+
+=head1 DESCRIPTION
+
+B::Deparse is a backend module for the Perl compiler that generates
+perl source code, based on the internal compiled structure that perl
+itself creates after parsing a program. The output of B::Deparse won't
+be exactly the same as the original source, since perl doesn't keep
+track of comments or whitespace, and there isn't a one-to-one
+correspondence between perl's syntactical constructions and their
+compiled form, but it will often be close. When you use the B<-p>
+option, the output also includes parentheses even when they are not
+required by precedence, which can make it easy to see if perl is
+parsing your expressions the way you intended.
+
+Please note that this module is mainly new and untested code and is
+still under development, so it may change in the future.
+
+=head1 OPTIONS
+
+As with all compiler backend options, these must follow directly after
+the '-MO=Deparse', separated by a comma but not any white space.
+
+=over 4
+
+=item B<-p>
+
+Print extra parentheses. Without this option, B::Deparse includes
+parentheses in its output only when they are needed, based on the
+structure of your program. With B<-p>, it uses parentheses (almost)
+whenever they would be legal. This can be useful if you are used to
+LISP, or if you want to see how perl parses your input. If you say
+
+    if ($var & 0x7f == 65) {print "Gimme an A!"} 
+    print ($which ? $a : $b), "\n";
+    $name = $ENV{USER} or "Bob";
+
+C<B::Deparse,-p> will print
+
+    if (($var & 0)) {
+        print('Gimme an A!')
+    };
+    (print(($which ? $a : $b)), '???');
+    (($name = $ENV{'USER'}) or '???')
+
+which probably isn't what you intended (the C<'???'> is a sign that
+perl optimized away a constant value).
+
+=item B<-u>I<PACKAGE>
+
+Normally, B::Deparse deparses the main code of a program, all the subs
+called by the main program (and all the subs called by them,
+recursively), and any other subs in the main:: package. To include
+subs in other packages that aren't called directly, such as AUTOLOAD,
+DESTROY, other subs called automatically by perl, and methods, which
+aren't resolved to subs until runtime, use the B<-u> option. The
+argument to B<-u> is the name of a package, and should follow directly
+after the 'u'. Multiple B<-u> options may be given, separated by
+commas.  Note that unlike some other backends, B::Deparse doesn't
+(yet) try to guess automatically when B<-u> is needed -- you must
+invoke it yourself.
+
+=item B<-l>
+
+Add '#line' declarations to the output based on the line and file
+locations of the original code.
+
+=item B<-s>I<LETTERS>
+
+Tweak the style of B::Deparse's output. At the moment, only one style
+option is implemented:
+
+=over 4
+
+=item B<C>
+
+Cuddle C<elsif>, C<else>, and C<continue> blocks. For example, print
+
+    if (...) {
+         ...
+    } else {
+         ...
+    }
+
+instead of
+
+    if (...) {
+         ...
+    }
+    else {
+         ...
+    }
+
+The default is not to cuddle.
+
+=back
+
+=back
+
+=head1 BUGS
+
+See the 'to do' list at the beginning of the module file.
+
+=head1 AUTHOR
+
+Stephen McCamant <alias@mcs.com>, based on an earlier version by
+Malcolm Beattie <mbeattie@sable.ox.ac.uk>.
+
+=cut
diff --git a/contrib/perl5/ext/B/B/Disassembler.pm b/contrib/perl5/ext/B/B/Disassembler.pm
new file mode 100644
index 0000000..f26441d
--- /dev/null
+++ b/contrib/perl5/ext/B/B/Disassembler.pm
@@ -0,0 +1,164 @@
+#      Disassembler.pm
+#
+#      Copyright (c) 1996 Malcolm Beattie
+#
+#      You may distribute under the terms of either the GNU General Public
+#      License or the Artistic License, as specified in the README file.
+package B::Disassembler::BytecodeStream;
+use FileHandle;
+use Carp;
+use B qw(cstring cast_I32);
+@ISA = qw(FileHandle);
+sub readn {
+    my ($fh, $len) = @_;
+    my $data;
+    read($fh, $data, $len);
+    croak "reached EOF while reading $len bytes" unless length($data) == $len;
+    return $data;
+}
+
+sub GET_U8 {
+    my $fh = shift;
+    my $c = $fh->getc;
+    croak "reached EOF while reading U8" unless defined($c);
+    return ord($c);
+}
+
+sub GET_U16 {
+    my $fh = shift;
+    my $str = $fh->readn(2);
+    croak "reached EOF while reading U16" unless length($str) == 2;
+    return unpack("n", $str);
+}
+
+sub GET_U32 {
+    my $fh = shift;
+    my $str = $fh->readn(4);
+    croak "reached EOF while reading U32" unless length($str) == 4;
+    return unpack("N", $str);
+}
+
+sub GET_I32 {
+    my $fh = shift;
+    my $str = $fh->readn(4);
+    croak "reached EOF while reading I32" unless length($str) == 4;
+    return cast_I32(unpack("N", $str));
+}
+
+sub GET_objindex { 
+    my $fh = shift;
+    my $str = $fh->readn(4);
+    croak "reached EOF while reading objindex" unless length($str) == 4;
+    return unpack("N", $str);
+}
+
+sub GET_strconst {
+    my $fh = shift;
+    my ($str, $c);
+    while (defined($c = $fh->getc) && $c ne "\0") {
+	$str .= $c;
+    }
+    croak "reached EOF while reading strconst" unless defined($c);
+    return cstring($str);
+}
+
+sub GET_pvcontents {}
+
+sub GET_PV {
+    my $fh = shift;
+    my $str;
+    my $len = $fh->GET_U32;
+    if ($len) {
+	read($fh, $str, $len);
+	croak "reached EOF while reading PV" unless length($str) == $len;
+	return cstring($str);
+    } else {
+	return '""';
+    }
+}
+
+sub GET_comment {
+    my $fh = shift;
+    my ($str, $c);
+    while (defined($c = $fh->getc) && $c ne "\n") {
+	$str .= $c;
+    }
+    croak "reached EOF while reading comment" unless defined($c);
+    return cstring($str);
+}
+
+sub GET_double {
+    my $fh = shift;
+    my ($str, $c);
+    while (defined($c = $fh->getc) && $c ne "\0") {
+	$str .= $c;
+    }
+    croak "reached EOF while reading double" unless defined($c);
+    return $str;
+}
+
+sub GET_none {}
+
+sub GET_op_tr_array {
+    my $fh = shift;
+    my @ary = unpack("n256", $fh->readn(256 * 2));
+    return join(",", @ary);
+}
+
+sub GET_IV64 {
+    my $fh = shift;
+    my ($hi, $lo) = unpack("NN", $fh->readn(8));
+    return sprintf("0x%4x%04x", $hi, $lo); # cheat
+}
+
+package B::Disassembler;
+use Exporter;
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(disassemble_fh);
+use Carp;
+use strict;
+
+use B::Asmdata qw(%insn_data @insn_name);
+
+sub disassemble_fh {
+    my ($fh, $out) = @_;
+    my ($c, $getmeth, $insn, $arg);
+    bless $fh, "B::Disassembler::BytecodeStream";
+    while (defined($c = $fh->getc)) {
+	$c = ord($c);
+	$insn = $insn_name[$c];
+	if (!defined($insn) || $insn eq "unused") {
+	    my $pos = $fh->tell - 1;
+	    die "Illegal instruction code $c at stream offset $pos\n";
+	}
+	$getmeth = $insn_data{$insn}->[2];
+	$arg = $fh->$getmeth();
+	if (defined($arg)) {
+	    &$out($insn, $arg);
+	} else {
+	    &$out($insn);
+	}
+    }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+B::Disassembler - Disassemble Perl bytecode
+
+=head1 SYNOPSIS
+
+	use Disassembler;
+
+=head1 DESCRIPTION
+
+See F<ext/B/B/Disassembler.pm>.
+
+=head1 AUTHOR
+
+Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
+
+=cut
diff --git a/contrib/perl5/ext/B/B/Lint.pm b/contrib/perl5/ext/B/B/Lint.pm
new file mode 100644
index 0000000..d34bd77
--- /dev/null
+++ b/contrib/perl5/ext/B/B/Lint.pm
@@ -0,0 +1,367 @@
+package B::Lint;
+
+=head1 NAME
+
+B::Lint - Perl lint
+
+=head1 SYNOPSIS
+
+perl -MO=Lint[,OPTIONS] foo.pl
+
+=head1 DESCRIPTION
+
+The B::Lint module is equivalent to an extended version of the B<-w>
+option of B<perl>. It is named after the program B<lint> which carries
+out a similar process for C programs.
+
+=head1 OPTIONS AND LINT CHECKS
+
+Option words are separated by commas (not whitespace) and follow the
+usual conventions of compiler backend options. Following any options
+(indicated by a leading B<->) come lint check arguments. Each such
+argument (apart from the special B<all> and B<none> options) is a
+word representing one possible lint check (turning on that check) or
+is B<no-foo> (turning off that check). Before processing the check
+arguments, a standard list of checks is turned on. Later options
+override earlier ones. Available options are:
+
+=over 8
+
+=item B<context>
+
+Produces a warning whenever an array is used in an implicit scalar
+context. For example, both of the lines
+
+    $foo = length(@bar);
+    $foo = @bar;
+will elicit a warning. Using an explicit B<scalar()> silences the
+warning. For example,
+
+    $foo = scalar(@bar);
+
+=item B<implicit-read> and B<implicit-write>
+
+These options produce a warning whenever an operation implicitly
+reads or (respectively) writes to one of Perl's special variables.
+For example, B<implicit-read> will warn about these:
+
+    /foo/;
+
+and B<implicit-write> will warn about these:
+
+    s/foo/bar/;
+
+Both B<implicit-read> and B<implicit-write> warn about this:
+
+    for (@a) { ... }
+
+=item B<dollar-underscore>
+
+This option warns whenever $_ is used either explicitly anywhere or
+as the implicit argument of a B<print> statement.
+
+=item B<private-names>
+
+This option warns on each use of any variable, subroutine or
+method name that lives in a non-current package but begins with
+an underscore ("_"). Warnings aren't issued for the special case
+of the single character name "_" by itself (e.g. $_ and @_).
+
+=item B<undefined-subs>
+
+This option warns whenever an undefined subroutine is invoked.
+This option will only catch explicitly invoked subroutines such
+as C<foo()> and not indirect invocations such as C<&$subref()>
+or C<$obj-E<gt>meth()>. Note that some programs or modules delay
+definition of subs until runtime by means of the AUTOLOAD
+mechanism.
+
+=item B<regexp-variables>
+
+This option warns whenever one of the regexp variables $', $& or
+$' is used. Any occurrence of any of these variables in your
+program can slow your whole program down. See L<perlre> for
+details.
+
+=item B<all>
+
+Turn all warnings on.
+
+=item B<none>
+
+Turn all warnings off.
+
+=back
+
+=head1 NON LINT-CHECK OPTIONS
+
+=over 8
+
+=item B<-u Package>
+
+Normally, Lint only checks the main code of the program together
+with all subs defined in package main. The B<-u> option lets you
+include other package names whose subs are then checked by Lint.
+
+=back
+
+=head1 BUGS
+
+This is only a very preliminary version.
+
+=head1 AUTHOR
+
+Malcolm Beattie, mbeattie@sable.ox.ac.uk.
+
+=cut
+
+use strict;
+use B qw(walkoptree_slow main_root walksymtable svref_2object parents);
+
+# Constants (should probably be elsewhere)
+sub G_ARRAY () { 1 }
+sub OPf_LIST () { 1 }
+sub OPf_KNOW () { 2 }
+sub OPf_STACKED () { 64 }
+
+my $file = "unknown";		# shadows current filename
+my $line = 0;			# shadows current line number
+my $curstash = "main";		# shadows current stash
+
+# Lint checks
+my %check;
+my %implies_ok_context;
+BEGIN {
+    map($implies_ok_context{$_}++,
+	qw(pp_scalar pp_av2arylen pp_aelem pp_aslice pp_helem pp_hslice
+	   pp_keys pp_values pp_hslice pp_defined pp_undef pp_delete));
+}
+
+# Lint checks turned on by default
+my @default_checks = qw(context);
+
+my %valid_check;
+# All valid checks
+BEGIN {
+    map($valid_check{$_}++,
+	qw(context implicit_read implicit_write dollar_underscore
+	   private_names undefined_subs regexp_variables));
+}
+
+# Debugging options
+my ($debug_op);
+
+my %done_cv;		# used to mark which subs have already been linted
+my @extra_packages;	# Lint checks mainline code and all subs which are
+			# in main:: or in one of these packages.
+
+sub warning {
+    my $format = (@_ < 2) ? "%s" : shift;
+    warn sprintf("$format at %s line %d\n", @_, $file, $line);
+}
+
+# This gimme can't cope with context that's only determined
+# at runtime via dowantarray().
+sub gimme {
+    my $op = shift;
+    my $flags = $op->flags;
+    if ($flags & OPf_KNOW) {
+	return(($flags & OPf_LIST) ? 1 : 0);
+    }
+    return undef;
+}
+
+sub B::OP::lint {}
+
+sub B::COP::lint {
+    my $op = shift;
+    if ($op->ppaddr eq "pp_nextstate") {
+	$file = $op->filegv->SV->PV;
+	$line = $op->line;
+	$curstash = $op->stash->NAME;
+    }
+}
+
+sub B::UNOP::lint {
+    my $op = shift;
+    my $ppaddr = $op->ppaddr;
+    if ($check{context} && ($ppaddr eq "pp_rv2av" || $ppaddr eq "pp_rv2hv")) {
+	my $parent = parents->[0];
+	my $pname = $parent->ppaddr;
+	return if gimme($op) || $implies_ok_context{$pname};
+	# Two special cases to deal with: "foreach (@foo)" and "delete $a{$b}"
+	# null out the parent so we have to check for a parent of pp_null and
+	# a grandparent of pp_enteriter or pp_delete
+	if ($pname eq "pp_null") {
+	    my $gpname = parents->[1]->ppaddr;
+	    return if $gpname eq "pp_enteriter" || $gpname eq "pp_delete";
+	}
+	warning("Implicit scalar context for %s in %s",
+		$ppaddr eq "pp_rv2av" ? "array" : "hash", $parent->desc);
+    }
+    if ($check{private_names} && $ppaddr eq "pp_method") {
+	my $methop = $op->first;
+	if ($methop->ppaddr eq "pp_const") {
+	    my $method = $methop->sv->PV;
+	    if ($method =~ /^_/ && !defined(&{"$curstash\::$method"})) {
+		warning("Illegal reference to private method name $method");
+	    }
+	}
+    }
+}
+
+sub B::PMOP::lint {
+    my $op = shift;
+    if ($check{implicit_read}) {
+	my $ppaddr = $op->ppaddr;
+	if ($ppaddr eq "pp_match" && !($op->flags & OPf_STACKED)) {
+	    warning('Implicit match on $_');
+	}
+    }
+    if ($check{implicit_write}) {
+	my $ppaddr = $op->ppaddr;
+	if ($ppaddr eq "pp_subst" && !($op->flags & OPf_STACKED)) {
+	    warning('Implicit substitution on $_');
+	}
+    }
+}
+
+sub B::LOOP::lint {
+    my $op = shift;
+    if ($check{implicit_read} || $check{implicit_write}) {
+	my $ppaddr = $op->ppaddr;
+	if ($ppaddr eq "pp_enteriter") {
+	    my $last = $op->last;
+	    if ($last->ppaddr eq "pp_gv" && $last->gv->NAME eq "_") {
+		warning('Implicit use of $_ in foreach');
+	    }
+	}
+    }
+}
+
+sub B::GVOP::lint {
+    my $op = shift;
+    if ($check{dollar_underscore} && $op->ppaddr eq "pp_gvsv"
+	&& $op->gv->NAME eq "_")
+    {
+	warning('Use of $_');
+    }
+    if ($check{private_names}) {
+	my $ppaddr = $op->ppaddr;
+	my $gv = $op->gv;
+	if (($ppaddr eq "pp_gv" || $ppaddr eq "pp_gvsv")
+	    && $gv->NAME =~ /^_./ && $gv->STASH->NAME ne $curstash)
+	{
+	    warning('Illegal reference to private name %s', $gv->NAME);
+	}
+    }
+    if ($check{undefined_subs}) {
+	if ($op->ppaddr eq "pp_gv" && $op->next->ppaddr eq "pp_entersub") {
+	    my $gv = $op->gv;
+	    my $subname = $gv->STASH->NAME . "::" . $gv->NAME;
+	    no strict 'refs';
+	    if (!defined(&$subname)) {
+		$subname =~ s/^main:://;
+		warning('Undefined subroutine %s called', $subname);
+	    }
+	}
+    }
+    if ($check{regexp_variables} && $op->ppaddr eq "pp_gvsv") {
+	my $name = $op->gv->NAME;
+	if ($name =~ /^[&'`]$/) {
+	    warning('Use of regexp variable $%s', $name);
+	}
+    }
+}
+
+sub B::GV::lintcv {
+    my $gv = shift;
+    my $cv = $gv->CV;
+    #warn sprintf("lintcv: %s::%s (done=%d)\n",
+    #		 $gv->STASH->NAME, $gv->NAME, $done_cv{$$cv});#debug
+    return if !$$cv || $done_cv{$$cv}++;
+    my $root = $cv->ROOT;
+    #warn "    root = $root (0x$$root)\n";#debug
+    walkoptree_slow($root, "lint") if $$root;
+}
+
+sub do_lint {
+    my %search_pack;
+    walkoptree_slow(main_root, "lint") if ${main_root()};
+    
+    # Now do subs in main
+    no strict qw(vars refs);
+    my $sym;
+    local(*glob);
+    while (($sym, *glob) = each %{"main::"}) {
+	#warn "Trying $sym\n";#debug
+	svref_2object(\*glob)->EGV->lintcv unless $sym =~ /::$/;
+    }
+
+    # Now do subs in non-main packages given by -u options
+    map { $search_pack{$_} = 1 } @extra_packages;
+    walksymtable(\%{"main::"}, "lintcv", sub {
+	my $package = shift;
+	$package =~ s/::$//;
+	#warn "Considering $package\n";#debug
+	return exists $search_pack{$package};
+    });
+}
+
+sub compile {
+    my @options = @_;
+    my ($option, $opt, $arg);
+    # Turn on default lint checks
+    for $opt (@default_checks) {
+	$check{$opt} = 1;
+    }
+  OPTION:
+    while ($option = shift @options) {
+	if ($option =~ /^-(.)(.*)/) {
+	    $opt = $1;
+	    $arg = $2;
+	} else {
+	    unshift @options, $option;
+	    last OPTION;
+	}
+	if ($opt eq "-" && $arg eq "-") {
+	    shift @options;
+	    last OPTION;
+	} elsif ($opt eq "D") {
+            $arg ||= shift @options;
+	    foreach $arg (split(//, $arg)) {
+		if ($arg eq "o") {
+		    B->debug(1);
+		} elsif ($arg eq "O") {
+		    $debug_op = 1;
+		}
+	    }
+	} elsif ($opt eq "u") {
+	    $arg ||= shift @options;
+	    push(@extra_packages, $arg);
+	}
+    }
+    foreach $opt (@default_checks, @options) {
+	$opt =~ tr/-/_/;
+	if ($opt eq "all") {
+	    %check = %valid_check;
+	}
+	elsif ($opt eq "none") {
+	    %check = ();
+	}
+	else {
+	    if ($opt =~ s/^no-//) {
+		$check{$opt} = 0;
+	    }
+	    else {
+		$check{$opt} = 1;
+	    }
+	    warn "No such check: $opt\n" unless defined $valid_check{$opt};
+	}
+    }
+    # Remaining arguments are things to check
+    
+    return \&do_lint;
+}
+
+1;
diff --git a/contrib/perl5/ext/B/B/Showlex.pm b/contrib/perl5/ext/B/B/Showlex.pm
new file mode 100644
index 0000000..648f95d
--- /dev/null
+++ b/contrib/perl5/ext/B/B/Showlex.pm
@@ -0,0 +1,80 @@
+package B::Showlex;
+use strict;
+use B qw(svref_2object comppadlist class);
+use B::Terse ();
+
+#
+# Invoke as
+#     perl -MO=Showlex,foo bar.pl
+# to see the names of lexical variables used by &foo
+# or as
+#     perl -MO=Showlex bar.pl
+# to see the names of file scope lexicals used by bar.pl
+#    
+
+sub showarray {
+    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: ";
+	$els[$i]->terse;
+    }
+}
+
+sub showlex {
+    my ($objname, $namesav, $valsav) = @_;
+    showarray("Pad of lexical names for $objname", $namesav);
+    showarray("Pad of lexical values for $objname", $valsav);
+}
+
+sub showlex_obj {
+    my ($objname, $obj) = @_;
+    $objname =~ s/^&main::/&/;
+    showlex($objname, svref_2object($obj)->PADLIST->ARRAY);
+}
+
+sub showlex_main {
+    showlex("comppadlist", comppadlist->ARRAY);
+}
+
+sub compile {
+    my @options = @_;
+    if (@options) {
+	return sub {
+	    my $objname;
+	    foreach $objname (@options) {
+		$objname = "main::$objname" unless $objname =~ /::/;
+		eval "showlex_obj('&$objname', \\&$objname)";
+	    }
+	}
+    } else {
+	return \&showlex_main;
+    }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+B::Showlex - Show lexical variables used in functions or files
+
+=head1 SYNOPSIS
+
+	perl -MO=Showlex[,SUBROUTINE] foo.pl
+
+=head1 DESCRIPTION
+
+When a subroutine name is provided in OPTIONS, prints the lexical
+variables used in that subroutine.  Otherwise, prints the file-scope
+lexicals in the file.
+
+=head1 AUTHOR
+
+Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
+
+=cut
diff --git a/contrib/perl5/ext/B/B/Stackobj.pm b/contrib/perl5/ext/B/B/Stackobj.pm
new file mode 100644
index 0000000..eea966c
--- /dev/null
+++ b/contrib/perl5/ext/B/B/Stackobj.pm
@@ -0,0 +1,301 @@
+#      Stackobj.pm
+#
+#      Copyright (c) 1996 Malcolm Beattie
+#
+#      You may distribute under the terms of either the GNU General Public
+#      License or the Artistic License, as specified in the README file.
+#
+package B::Stackobj;
+use Exporter ();
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(set_callback T_UNKNOWN T_DOUBLE T_INT
+		VALID_INT VALID_DOUBLE VALID_SV REGISTER TEMPORARY);
+%EXPORT_TAGS = (types => [qw(T_UNKNOWN T_DOUBLE T_INT)],
+		flags => [qw(VALID_INT VALID_DOUBLE VALID_SV
+			     REGISTER TEMPORARY)]);
+
+use Carp qw(confess);
+use strict;
+use B qw(class);
+
+# Perl internal constants that I should probably define elsewhere.
+sub SVf_IOK () { 0x10000 }
+sub SVf_NOK () { 0x20000 }
+
+# Types
+sub T_UNKNOWN () { 0 }
+sub T_DOUBLE ()  { 1 }
+sub T_INT ()     { 2 }
+
+# Flags
+sub VALID_INT ()	{ 0x01 }
+sub VALID_DOUBLE ()	{ 0x02 }
+sub VALID_SV ()		{ 0x04 }
+sub REGISTER ()		{ 0x08 } # no implicit write-back when calling subs
+sub TEMPORARY ()	{ 0x10 } # no implicit write-back needed at all
+
+#
+# Callback for runtime code generation
+#
+my $runtime_callback = sub { confess "set_callback not yet called" };
+sub set_callback (&) { $runtime_callback = shift }
+sub runtime { &$runtime_callback(@_) }
+
+#
+# Methods
+#
+
+sub write_back { confess "stack object does not implement write_back" }
+
+sub invalidate { shift->{flags} &= ~(VALID_INT | VALID_DOUBLE) }
+
+sub as_sv {
+    my $obj = shift;
+    if (!($obj->{flags} & VALID_SV)) {
+	$obj->write_back;
+	$obj->{flags} |= VALID_SV;
+    }
+    return $obj->{sv};
+}
+
+sub as_int {
+    my $obj = shift;
+    if (!($obj->{flags} & VALID_INT)) {
+	$obj->load_int;
+	$obj->{flags} |= VALID_INT;
+    }
+    return $obj->{iv};
+}
+
+sub as_double {
+    my $obj = shift;
+    if (!($obj->{flags} & VALID_DOUBLE)) {
+	$obj->load_double;
+	$obj->{flags} |= VALID_DOUBLE;
+    }
+    return $obj->{nv};
+}
+
+sub as_numeric {
+    my $obj = shift;
+    return $obj->{type} == T_INT ? $obj->as_int : $obj->as_double;
+}
+
+#
+# Debugging methods
+#
+sub peek {
+    my $obj = shift;
+    my $type = $obj->{type};
+    my $flags = $obj->{flags};
+    my @flags;
+    if ($type == T_UNKNOWN) {
+	$type = "T_UNKNOWN";
+    } elsif ($type == T_INT) {
+	$type = "T_INT";
+    } elsif ($type == T_DOUBLE) {
+	$type = "T_DOUBLE";
+    } else {
+	$type = "(illegal type $type)";
+    }
+    push(@flags, "VALID_INT") if $flags & VALID_INT;
+    push(@flags, "VALID_DOUBLE") if $flags & VALID_DOUBLE;
+    push(@flags, "VALID_SV") if $flags & VALID_SV;
+    push(@flags, "REGISTER") if $flags & REGISTER;
+    push(@flags, "TEMPORARY") if $flags & TEMPORARY;
+    @flags = ("none") unless @flags;
+    return sprintf("%s type=$type flags=%s sv=$obj->{sv}",
+		   class($obj), join("|", @flags));
+}
+
+sub minipeek {
+    my $obj = shift;
+    my $type = $obj->{type};
+    my $flags = $obj->{flags};
+    if ($type == T_INT || $flags & VALID_INT) {
+	return $obj->{iv};
+    } elsif ($type == T_DOUBLE || $flags & VALID_DOUBLE) {
+	return $obj->{nv};
+    } else {
+	return $obj->{sv};
+    }
+}
+
+#
+# Caller needs to ensure that set_int, set_double,
+# set_numeric and set_sv are only invoked on legal lvalues.
+#
+sub set_int {
+    my ($obj, $expr) = @_;
+    runtime("$obj->{iv} = $expr;");
+    $obj->{flags} &= ~(VALID_SV | VALID_DOUBLE);
+    $obj->{flags} |= VALID_INT;
+}
+
+sub set_double {
+    my ($obj, $expr) = @_;
+    runtime("$obj->{nv} = $expr;");
+    $obj->{flags} &= ~(VALID_SV | VALID_INT);
+    $obj->{flags} |= VALID_DOUBLE;
+}
+
+sub set_numeric {
+    my ($obj, $expr) = @_;
+    if ($obj->{type} == T_INT) {
+	$obj->set_int($expr);
+    } else {
+	$obj->set_double($expr);
+    }
+}
+
+sub set_sv {
+    my ($obj, $expr) = @_;
+    runtime("SvSetSV($obj->{sv}, $expr);");
+    $obj->invalidate;
+    $obj->{flags} |= VALID_SV;
+}
+
+#
+# Stackobj::Padsv
+#
+
+@B::Stackobj::Padsv::ISA = 'B::Stackobj';
+sub B::Stackobj::Padsv::new {
+    my ($class, $type, $extra_flags, $ix, $iname, $dname) = @_;
+    bless {
+	type => $type,
+	flags => VALID_SV | $extra_flags,
+	sv => "PL_curpad[$ix]",
+	iv => "$iname",
+	nv => "$dname"
+    }, $class;
+}
+
+sub B::Stackobj::Padsv::load_int {
+    my $obj = shift;
+    if ($obj->{flags} & VALID_DOUBLE) {
+	runtime("$obj->{iv} = $obj->{nv};");
+    } else {
+	runtime("$obj->{iv} = SvIV($obj->{sv});");
+    }
+    $obj->{flags} |= VALID_INT;
+}
+
+sub B::Stackobj::Padsv::load_double {
+    my $obj = shift;
+    $obj->write_back;
+    runtime("$obj->{nv} = SvNV($obj->{sv});");
+    $obj->{flags} |= VALID_DOUBLE;
+}
+
+sub B::Stackobj::Padsv::write_back {
+    my $obj = shift;
+    my $flags = $obj->{flags};
+    return if $flags & VALID_SV;
+    if ($flags & VALID_INT) {
+	runtime("sv_setiv($obj->{sv}, $obj->{iv});");
+    } elsif ($flags & VALID_DOUBLE) {
+	runtime("sv_setnv($obj->{sv}, $obj->{nv});");
+    } else {
+	confess "write_back failed for lexical @{[$obj->peek]}\n";
+    }
+    $obj->{flags} |= VALID_SV;
+}
+
+#
+# Stackobj::Const
+#
+
+@B::Stackobj::Const::ISA = 'B::Stackobj';
+sub B::Stackobj::Const::new {
+    my ($class, $sv) = @_;
+    my $obj = bless {
+	flags => 0,
+	sv => $sv    # holds the SV object until write_back happens
+    }, $class;
+    my $svflags = $sv->FLAGS;
+    if ($svflags & SVf_IOK) {
+	$obj->{flags} = VALID_INT|VALID_DOUBLE;
+	$obj->{type} = T_INT;
+	$obj->{nv} = $obj->{iv} = $sv->IV;
+    } elsif ($svflags & SVf_NOK) {
+	$obj->{flags} = VALID_INT|VALID_DOUBLE;
+	$obj->{type} = T_DOUBLE;
+	$obj->{iv} = $obj->{nv} = $sv->NV;
+    } else {
+	$obj->{type} = T_UNKNOWN;
+    }
+    return $obj;
+}
+
+sub B::Stackobj::Const::write_back {
+    my $obj = shift;
+    return if $obj->{flags} & VALID_SV;
+    # Save the SV object and replace $obj->{sv} by its C source code name
+    $obj->{sv} = $obj->{sv}->save;
+    $obj->{flags} |= VALID_SV|VALID_INT|VALID_DOUBLE;
+}
+
+sub B::Stackobj::Const::load_int {
+    my $obj = shift;
+    $obj->{iv} = int($obj->{sv}->PV);
+    $obj->{flags} |= VALID_INT;
+}
+
+sub B::Stackobj::Const::load_double {
+    my $obj = shift;
+    $obj->{nv} = $obj->{sv}->PV + 0.0;
+    $obj->{flags} |= VALID_DOUBLE;
+}
+
+sub B::Stackobj::Const::invalidate {}
+
+#
+# Stackobj::Bool
+#
+
+@B::Stackobj::Bool::ISA = 'B::Stackobj';
+sub B::Stackobj::Bool::new {
+    my ($class, $preg) = @_;
+    my $obj = bless {
+	type => T_INT,
+	flags => VALID_INT|VALID_DOUBLE,
+	iv => $$preg,
+	nv => $$preg,
+	preg => $preg		# this holds our ref to the pseudo-reg
+    }, $class;
+    return $obj;
+}
+
+sub B::Stackobj::Bool::write_back {
+    my $obj = shift;
+    return if $obj->{flags} & VALID_SV;
+    $obj->{sv} = "($obj->{iv} ? &PL_sv_yes : &PL_sv_no)";
+    $obj->{flags} |= VALID_SV;
+}
+
+# XXX Might want to handle as_double/set_double/load_double?
+
+sub B::Stackobj::Bool::invalidate {}
+
+1;
+
+__END__
+
+=head1 NAME
+
+B::Stackobj - Helper module for CC backend
+
+=head1 SYNOPSIS
+
+	use B::Stackobj;
+
+=head1 DESCRIPTION
+
+See F<ext/B/README>.
+
+=head1 AUTHOR
+
+Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
+
+=cut
diff --git a/contrib/perl5/ext/B/B/Terse.pm b/contrib/perl5/ext/B/B/Terse.pm
new file mode 100644
index 0000000..93757f3
--- /dev/null
+++ b/contrib/perl5/ext/B/B/Terse.pm
@@ -0,0 +1,152 @@
+package B::Terse;
+use strict;
+use B qw(peekop class walkoptree_slow walkoptree_exec
+	 main_start main_root cstring svref_2object);
+use B::Asmdata qw(@specialsv_name);
+
+sub terse {
+    my ($order, $cvref) = @_;
+    my $cv = svref_2object($cvref);
+    if ($order eq "exec") {
+	walkoptree_exec($cv->START, "terse");
+    } else {
+	walkoptree_slow($cv->ROOT, "terse");
+    }
+}
+
+sub compile {
+    my $order = shift;
+    my @options = @_;
+    if (@options) {
+	return sub {
+	    my $objname;
+	    foreach $objname (@options) {
+		$objname = "main::$objname" unless $objname =~ /::/;
+		eval "terse(\$order, \\&$objname)";
+		die "terse($order, \\&$objname) failed: $@" if $@;
+	    }
+	}
+    } else {
+	if ($order eq "exec") {
+	    return sub { walkoptree_exec(main_start, "terse") }
+	} else {
+	    return sub { walkoptree_slow(main_root, "terse") }
+	}
+    }
+}
+
+sub indent {
+    my $level = shift;
+    return "    " x $level;
+}
+
+sub B::OP::terse {
+    my ($op, $level) = @_;
+    my $targ = $op->targ;
+    $targ = ($targ > 0) ? " [$targ]" : "";
+    print indent($level), peekop($op), $targ, "\n";
+}
+
+sub B::SVOP::terse {
+    my ($op, $level) = @_;
+    print indent($level), peekop($op), "  ";
+    $op->sv->terse(0);
+}
+
+sub B::GVOP::terse {
+    my ($op, $level) = @_;
+    print indent($level), peekop($op), "  ";
+    $op->gv->terse(0);
+}
+
+sub B::PMOP::terse {
+    my ($op, $level) = @_;
+    my $precomp = $op->precomp;
+    print indent($level), peekop($op),
+	defined($precomp) ? " /$precomp/\n" : " (regexp not compiled)\n";
+
+}
+
+sub B::PVOP::terse {
+    my ($op, $level) = @_;
+    print indent($level), peekop($op), " ", cstring($op->pv), "\n";
+}
+
+sub B::COP::terse {
+    my ($op, $level) = @_;
+    my $label = $op->label;
+    if ($label) {
+	$label = " label ".cstring($label);
+    }
+    print indent($level), peekop($op), $label, "\n";
+}
+
+sub B::PV::terse {
+    my ($sv, $level) = @_;
+    print indent($level);
+    printf "%s (0x%lx) %s\n", class($sv), $$sv, cstring($sv->PV);
+}
+
+sub B::AV::terse {
+    my ($sv, $level) = @_;
+    print indent($level);
+    printf "%s (0x%lx) FILL %d\n", class($sv), $$sv, $sv->FILL;
+}
+
+sub B::GV::terse {
+    my ($gv, $level) = @_;
+    my $stash = $gv->STASH->NAME;
+    if ($stash eq "main") {
+	$stash = "";
+    } else {
+	$stash = $stash . "::";
+    }
+    print indent($level);
+    printf "%s (0x%lx) *%s%s\n", class($gv), $$gv, $stash, $gv->NAME;
+}
+
+sub B::IV::terse {
+    my ($sv, $level) = @_;
+    print indent($level);
+    printf "%s (0x%lx) %d\n", class($sv), $$sv, $sv->IV;
+}
+
+sub B::NV::terse {
+    my ($sv, $level) = @_;
+    print indent($level);
+    printf "%s (0x%lx) %s\n", class($sv), $$sv, $sv->NV;
+}
+
+sub B::NULL::terse {
+    my ($sv, $level) = @_;
+    print indent($level);
+    printf "%s (0x%lx)\n", class($sv), $$sv;
+}
+    
+sub B::SPECIAL::terse {
+    my ($sv, $level) = @_;
+    print indent($level);
+    printf "%s #%d %s\n", class($sv), $$sv, $specialsv_name[$$sv];
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+B::Terse - Walk Perl syntax tree, printing terse info about ops
+
+=head1 SYNOPSIS
+
+	perl -MO=Terse[,OPTIONS] foo.pl
+
+=head1 DESCRIPTION
+
+See F<ext/B/README>.
+
+=head1 AUTHOR
+
+Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
+
+=cut
diff --git a/contrib/perl5/ext/B/B/Xref.pm b/contrib/perl5/ext/B/B/Xref.pm
new file mode 100644
index 0000000..0102856
--- /dev/null
+++ b/contrib/perl5/ext/B/B/Xref.pm
@@ -0,0 +1,392 @@
+package B::Xref;
+
+=head1 NAME
+
+B::Xref - Generates cross reference reports for Perl programs
+
+=head1 SYNOPSIS
+
+perl -MO=Xref[,OPTIONS] foo.pl
+
+=head1 DESCRIPTION
+
+The B::Xref module is used to generate a cross reference listing of all
+definitions and uses of variables, subroutines and formats in a Perl program.
+It is implemented as a backend for the Perl compiler.
+
+The report generated is in the following format:
+
+    File filename1
+      Subroutine subname1
+	Package package1
+	  object1        C<line numbers>
+	  object2        C<line numbers>
+	  ...
+	Package package2
+	...
+
+Each B<File> section reports on a single file. Each B<Subroutine> section
+reports on a single subroutine apart from the special cases
+"(definitions)" and "(main)". These report, respectively, on subroutine
+definitions found by the initial symbol table walk and on the main part of
+the program or module external to all subroutines.
+
+The report is then grouped by the B<Package> of each variable,
+subroutine or format with the special case "(lexicals)" meaning
+lexical variables. Each B<object> name (implicitly qualified by its
+containing B<Package>) includes its type character(s) at the beginning
+where possible. Lexical variables are easier to track and even
+included dereferencing information where possible.
+
+The C<line numbers> are a comma separated list of line numbers (some
+preceded by code letters) where that object is used in some way.
+Simple uses aren't preceded by a code letter. Introductions (such as
+where a lexical is first defined with C<my>) are indicated with the
+letter "i". Subroutine and method calls are indicated by the character
+"&".  Subroutine definitions are indicated by "s" and format
+definitions by "f".
+
+=head1 OPTIONS
+
+Option words are separated by commas (not whitespace) and follow the
+usual conventions of compiler backend options.
+
+=over 8
+
+=item C<-oFILENAME>
+
+Directs output to C<FILENAME> instead of standard output.
+
+=item C<-r>
+
+Raw output. Instead of producing a human-readable report, outputs a line
+in machine-readable form for each definition/use of a variable/sub/format.
+
+=item C<-D[tO]>
+
+(Internal) debug options, probably only useful if C<-r> included.
+The C<t> option prints the object on the top of the stack as it's
+being tracked. The C<O> option prints each operator as it's being
+processed in the execution order of the program.
+
+=back
+
+=head1 BUGS
+
+Non-lexical variables are quite difficult to track through a program.
+Sometimes the type of a non-lexical variable's use is impossible to
+determine. Introductions of non-lexical non-scalars don't seem to be
+reported properly.
+
+=head1 AUTHOR
+
+Malcolm Beattie, mbeattie@sable.ox.ac.uk.
+
+=cut
+
+use strict;
+use B qw(peekop class comppadlist main_start svref_2object walksymtable);
+
+# Constants (should probably be elsewhere)
+sub OPpLVAL_INTRO () { 128 }
+sub SVf_POK () { 0x40000 }
+
+sub UNKNOWN { ["?", "?", "?"] }
+
+my @pad;			# lexicals in current pad
+				# as ["(lexical)", type, name]
+my %done;			# keyed by $$op: set when each $op is done
+my $top = UNKNOWN;		# shadows top element of stack as
+				# [pack, type, name] (pack can be "(lexical)")
+my $file;			# shadows current filename
+my $line;			# shadows current line number
+my $subname;			# shadows current sub name
+my %table;			# Multi-level hash to record all uses etc.
+my @todo = ();			# List of CVs that need processing
+
+my %code = (intro => "i", used => "",
+	    subdef => "s", subused => "&",
+	    formdef => "f", meth => "->");
+
+
+# Options
+my ($debug_op, $debug_top, $nodefs, $raw);
+
+sub process {
+    my ($var, $event) = @_;
+    my ($pack, $type, $name) = @$var;
+    if ($type eq "*") {
+	if ($event eq "used") {
+	    return;
+	} elsif ($event eq "subused") {
+	    $type = "&";
+	}
+    }
+    $type =~ s/(.)\*$/$1/g;
+    if ($raw) {
+	printf "%-16s %-12s %5d %-12s %4s %-16s %s\n",
+	    $file, $subname, $line, $pack, $type, $name, $event;
+    } else {
+	# Wheee
+	push(@{$table{$file}->{$subname}->{$pack}->{$type.$name}->{$event}},
+	    $line);
+    }
+}
+
+sub load_pad {
+    my $padlist = shift;
+    my ($namelistav, @namelist, $ix);
+    @pad = ();
+    return if class($padlist) eq "SPECIAL";
+    ($namelistav) = $padlist->ARRAY;
+    @namelist = $namelistav->ARRAY;
+    for ($ix = 1; $ix < @namelist; $ix++) {
+	my $namesv = $namelist[$ix];
+	next if class($namesv) eq "SPECIAL";
+	my ($type, $name) = $namesv->PV =~ /^(.)(.*)$/;
+	$pad[$ix] = ["(lexical)", $type, $name];
+    }
+}
+
+sub xref {
+    my $start = shift;
+    my $op;
+    for ($op = $start; $$op; $op = $op->next) {
+	last if $done{$$op}++;
+	warn sprintf("top = [%s, %s, %s]\n", @$top) if $debug_top;
+	warn peekop($op), "\n" if $debug_op;
+	my $ppname = $op->ppaddr;
+	if ($ppname =~ /^pp_(or|and|mapwhile|grepwhile)$/) {
+	    xref($op->other);
+	} elsif ($ppname eq "pp_match" || $ppname eq "pp_subst") {
+	    xref($op->pmreplstart);
+	} elsif ($ppname eq "pp_substcont") {
+	    xref($op->other->pmreplstart);
+	    $op = $op->other;
+	    redo;
+	} elsif ($ppname eq "pp_cond_expr") {
+	    # pp_cond_expr never returns op_next
+	    xref($op->true);
+	    $op = $op->false;
+	    redo;
+	} elsif ($ppname eq "pp_enterloop") {
+	    xref($op->redoop);
+	    xref($op->nextop);
+	    xref($op->lastop);
+	} elsif ($ppname eq "pp_subst") {
+	    xref($op->pmreplstart);
+	} else {
+	    no strict 'refs';
+	    &$ppname($op) if defined(&$ppname);
+	}
+    }
+}
+
+sub xref_cv {
+    my $cv = shift;
+    my $pack = $cv->GV->STASH->NAME;
+    $subname = ($pack eq "main" ? "" : "$pack\::") . $cv->GV->NAME;
+    load_pad($cv->PADLIST);
+    xref($cv->START);
+    $subname = "(main)";
+}
+
+sub xref_object {
+    my $cvref = shift;
+    xref_cv(svref_2object($cvref));
+}
+
+sub xref_main {
+    $subname = "(main)";
+    load_pad(comppadlist);
+    xref(main_start);
+    while (@todo) {
+	xref_cv(shift @todo);
+    }
+}
+
+sub pp_nextstate {
+    my $op = shift;
+    $file = $op->filegv->SV->PV;
+    $line = $op->line;
+    $top = UNKNOWN;
+}
+
+sub pp_padsv {
+    my $op = shift;
+    $top = $pad[$op->targ];
+    process($top, $op->private & OPpLVAL_INTRO ? "intro" : "used");
+}
+
+sub pp_padav { pp_padsv(@_) }
+sub pp_padhv { pp_padsv(@_) }
+
+sub deref {
+    my ($var, $as) = @_;
+    $var->[1] = $as . $var->[1];
+    process($var, "used");
+}
+
+sub pp_rv2cv { deref($top, "&"); }
+sub pp_rv2hv { deref($top, "%"); }
+sub pp_rv2sv { deref($top, "\$"); }
+sub pp_rv2av { deref($top, "\@"); }
+sub pp_rv2gv { deref($top, "*"); }
+
+sub pp_gvsv {
+    my $op = shift;
+    my $gv = $op->gv;
+    $top = [$gv->STASH->NAME, '$', $gv->NAME];
+    process($top, $op->private & OPpLVAL_INTRO ? "intro" : "used");
+}
+
+sub pp_gv {
+    my $op = shift;
+    my $gv = $op->gv;
+    $top = [$gv->STASH->NAME, "*", $gv->NAME];
+    process($top, $op->private & OPpLVAL_INTRO ? "intro" : "used");
+}
+
+sub pp_const {
+    my $op = shift;
+    my $sv = $op->sv;
+    $top = ["?", "",
+	    (class($sv) ne "SPECIAL" && $sv->FLAGS & SVf_POK) ? $sv->PV : "?"];
+}
+
+sub pp_method {
+    my $op = shift;
+    $top = ["(method)", "->".$top->[1], $top->[2]];
+}
+
+sub pp_entersub {
+    my $op = shift;
+    if ($top->[1] eq "m") {
+	process($top, "meth");
+    } else {
+	process($top, "subused");
+    }
+    $top = UNKNOWN;
+}
+
+#
+# Stuff for cross referencing definitions of variables and subs
+#
+
+sub B::GV::xref {
+    my $gv = shift;
+    my $cv = $gv->CV;
+    if ($$cv) {
+	#return if $done{$$cv}++;
+	$file = $gv->FILEGV->SV->PV;
+	$line = $gv->LINE;
+	process([$gv->STASH->NAME, "&", $gv->NAME], "subdef");
+	push(@todo, $cv);
+    }
+    my $form = $gv->FORM;
+    if ($$form) {
+	return if $done{$$form}++;
+	$file = $gv->FILEGV->SV->PV;
+	$line = $gv->LINE;
+	process([$gv->STASH->NAME, "", $gv->NAME], "formdef");
+    }
+}
+
+sub xref_definitions {
+    my ($pack, %exclude);
+    return if $nodefs;
+    $subname = "(definitions)";
+    foreach $pack (qw(B O AutoLoader DynaLoader Config DB VMS
+		      strict vars FileHandle Exporter Carp)) {
+        $exclude{$pack."::"} = 1;
+    }
+    no strict qw(vars refs);
+    walksymtable(\%{"main::"}, "xref", sub { !defined($exclude{$_[0]}) });
+}
+
+sub output {
+    return if $raw;
+    my ($file, $subname, $pack, $name, $ev, $perfile, $persubname,
+	$perpack, $pername, $perev);
+    foreach $file (sort(keys(%table))) {
+	$perfile = $table{$file};
+	print "File $file\n";
+	foreach $subname (sort(keys(%$perfile))) {
+	    $persubname = $perfile->{$subname};
+	    print "  Subroutine $subname\n";
+	    foreach $pack (sort(keys(%$persubname))) {
+		$perpack = $persubname->{$pack};
+		print "    Package $pack\n";
+		foreach $name (sort(keys(%$perpack))) {
+		    $pername = $perpack->{$name};
+		    my @lines;
+		    foreach $ev (qw(intro formdef subdef meth subused used)) {
+			$perev = $pername->{$ev};
+			if (defined($perev) && @$perev) {
+			    my $code = $code{$ev};
+			    push(@lines, map("$code$_", @$perev));
+			}
+		    }
+		    printf "      %-16s  %s\n", $name, join(", ", @lines);
+		}
+	    }
+	}
+    }
+}
+
+sub compile {
+    my @options = @_;
+    my ($option, $opt, $arg);
+  OPTION:
+    while ($option = shift @options) {
+	if ($option =~ /^-(.)(.*)/) {
+	    $opt = $1;
+	    $arg = $2;
+	} else {
+	    unshift @options, $option;
+	    last OPTION;
+	}
+	if ($opt eq "-" && $arg eq "-") {
+	    shift @options;
+	    last OPTION;
+	} elsif ($opt eq "o") {
+	    $arg ||= shift @options;
+	    open(STDOUT, ">$arg") or return "$arg: $!\n";
+	} elsif ($opt eq "d") {
+	    $nodefs = 1;
+	} elsif ($opt eq "r") {
+	    $raw = 1;
+	} elsif ($opt eq "D") {
+            $arg ||= shift @options;
+	    foreach $arg (split(//, $arg)) {
+		if ($arg eq "o") {
+		    B->debug(1);
+		} elsif ($arg eq "O") {
+		    $debug_op = 1;
+		} elsif ($arg eq "t") {
+		    $debug_top = 1;
+		}
+	    }
+	}
+    }
+    if (@options) {
+	return sub {
+	    my $objname;
+	    xref_definitions();
+	    foreach $objname (@options) {
+		$objname = "main::$objname" unless $objname =~ /::/;
+		eval "xref_object(\\&$objname)";
+		die "xref_object(\\&$objname) failed: $@" if $@;
+	    }
+	    output();
+	}
+    } else {
+	return sub {
+	    xref_definitions();
+	    xref_main();
+	    output();
+	}
+    }
+}
+
+1;
diff --git a/contrib/perl5/ext/B/B/assemble b/contrib/perl5/ext/B/B/assemble
new file mode 100755
index 0000000..43cc5bc
--- /dev/null
+++ b/contrib/perl5/ext/B/B/assemble
@@ -0,0 +1,30 @@
+use B::Assembler qw(assemble_fh);
+use FileHandle;
+
+my ($filename, $fh, $out);
+
+if ($ARGV[0] eq "-d") {
+    B::Assembler::debug(1);
+    shift;
+}
+
+$out = \*STDOUT;
+
+if (@ARGV == 0) {
+    $fh = \*STDIN;
+    $filename = "-";
+} elsif (@ARGV == 1) {
+    $filename = $ARGV[0];
+    $fh = new FileHandle "<$filename";
+} elsif (@ARGV == 2) {
+    $filename = $ARGV[0];
+    $fh = new FileHandle "<$filename";
+    $out = new FileHandle ">$ARGV[1]";
+} else {
+    die "Usage: assemble [filename] [outfilename]\n";
+}
+
+binmode $out;
+$SIG{__WARN__} = sub { warn "$filename:@_" };
+$SIG{__DIE__} = sub { die "$filename: @_" };
+assemble_fh($fh, sub { print $out @_ });
diff --git a/contrib/perl5/ext/B/B/cc_harness b/contrib/perl5/ext/B/B/cc_harness
new file mode 100644
index 0000000..79f8727
--- /dev/null
+++ b/contrib/perl5/ext/B/B/cc_harness
@@ -0,0 +1,12 @@
+use Config;
+
+$libdir = $ENV{PERL_SRC} || "$Config{installarchlib}/CORE";
+
+if (!grep(/^-[cS]$/, @ARGV)) {
+    $linkargs = sprintf("%s $libdir/$Config{libperl} %s",
+			@Config{qw(ldflags libs)});
+}
+
+$cccmd = "$Config{cc} $Config{ccflags} -I$libdir @ARGV $linkargs";
+print "$cccmd\n";
+exec $cccmd;
diff --git a/contrib/perl5/ext/B/B/disassemble b/contrib/perl5/ext/B/B/disassemble
new file mode 100755
index 0000000..6530b80
--- /dev/null
+++ b/contrib/perl5/ext/B/B/disassemble
@@ -0,0 +1,22 @@
+use B::Disassembler qw(disassemble_fh);
+use FileHandle;
+
+my $fh;
+if (@ARGV == 0) {
+    $fh = \*STDIN;
+} elsif (@ARGV == 1) {
+    $fh = new FileHandle "<$ARGV[0]";
+} else {
+    die "Usage: disassemble [filename]\n";
+}
+
+sub print_insn {
+    my ($insn, $arg) = @_;
+    if (defined($arg)) {
+	printf "%s %s\n", $insn, $arg;
+    } else {
+	print $insn, "\n";
+    }
+}
+
+disassemble_fh($fh, \&print_insn);
diff --git a/contrib/perl5/ext/B/B/makeliblinks b/contrib/perl5/ext/B/B/makeliblinks
new file mode 100644
index 0000000..8256078
--- /dev/null
+++ b/contrib/perl5/ext/B/B/makeliblinks
@@ -0,0 +1,54 @@
+use File::Find;
+use Config;
+
+if (@ARGV != 2) {
+    warn <<"EOT";
+Usage: makeliblinks libautodir targetdir
+where libautodir is the architecture-dependent auto directory
+(e.g. $Config::Config{archlib}/auto).
+EOT
+    exit 2;
+}
+
+my ($libautodir, $targetdir) = @ARGV;
+
+# Calculate relative path prefix from $targetdir to $libautodir
+sub relprefix {
+    my ($to, $from) = @_;
+    my $up;
+    for ($up = 0; substr($to, 0, length($from)) ne $from; $up++) {
+	$from =~ s(
+		   [^/]+	(?# a group of non-slashes) 
+		   /*		(?# maybe with some trailing slashes)
+		   $		(?# at the end of the path)
+                  )()x;
+    }
+    return (("../" x $up) . substr($to, length($from)));
+}
+
+my $relprefix = relprefix($libautodir, $targetdir);
+
+my ($dlext, $lib_ext) = @Config::Config{qw(dlext lib_ext)};
+
+sub link_if_library {
+    if (/\.($dlext|$lib_ext)$/o) {
+	my $ext = $1;
+	my $name = $File::Find::name;
+	if (substr($name, 0, length($libautodir) + 1) ne "$libautodir/") {
+	    die "directory of $name doesn't match $libautodir\n";
+	}
+	substr($name, 0, length($libautodir) + 1) = '';
+	my @parts = split(m(/), $name);
+	if ($parts[-1] ne "$parts[-2].$ext") {
+	    die "module name $_ doesn't match its directory $libautodir\n";
+	}
+	pop @parts;
+	my $libpath = "$targetdir/lib" . join("__", @parts) . ".$ext";
+	print "$libpath -> $relprefix/$name\n";
+	symlink("$relprefix/$name", $libpath)
+	    or warn "above link failed with error: $!\n";
+    }
+}
+
+find(\&link_if_library, $libautodir);
+exit 0;
diff --git a/contrib/perl5/ext/B/Makefile.PL b/contrib/perl5/ext/B/Makefile.PL
new file mode 100644
index 0000000..cdcc4ed
--- /dev/null
+++ b/contrib/perl5/ext/B/Makefile.PL
@@ -0,0 +1,46 @@
+use ExtUtils::MakeMaker;
+use Config;
+
+my $e = $Config{'exe_ext'};
+my $o = $Config{'obj_ext'};
+my $exeout_flag = '-o ';
+if ($^O eq 'MSWin32') {
+    if ($Config{'cc'} =~ /^cl/i) {
+	$exeout_flag = '-Fe';
+    }
+    elsif ($Config{'cc'} =~ /^bcc/i) {
+	$exeout_flag = '-e';
+    }
+}
+
+WriteMakefile(
+    NAME	=> "B",
+    VERSION	=> "a5",
+    MAN3PODS => ' ',
+    clean	=> {
+	FILES		=> "perl$e byteperl$e *$o B.c *~"
+    }
+);
+
+sub MY::post_constants {
+    "\nLIBS = $Config{libs}\n"
+}
+
+# Leave out doing byteperl for now. Probably should be built in the
+# core directory or somewhere else rather than here
+#sub MY::top_targets {
+#    my $self = shift;
+#    my $targets = $self->MM::top_targets();
+#    $targets =~ s/^(all ::.*)$/$1 byteperl$e/m;
+#    return <<"EOT" . $targets;
+
+#
+# byteperl is *not* a standard perl+XSUB executable. It's a special
+# program for running standalone bytecode executables. It isn't an XSUB
+# at the moment because a standlone Perl program needs to set up curpad
+# which is overwritten on exit from an XSUB.
+#
+#byteperl$e : byteperl$o B$o \$(PERL_SRC)/byterun$o
+#	\$(CC) ${exeout_flag}byteperl$e byteperl$o B$o byterun$o \$(LDFLAGS) \$(PERL_ARCHLIB)/CORE/$Config{libperl} \$(LIBS)
+#EOT
+#}
diff --git a/contrib/perl5/ext/B/NOTES b/contrib/perl5/ext/B/NOTES
new file mode 100644
index 0000000..ee10ba0
--- /dev/null
+++ b/contrib/perl5/ext/B/NOTES
@@ -0,0 +1,168 @@
+C backend invocation
+	If there are any non-option arguments, they are taken to be
+	names of objects to be saved (probably doesn't work properly yet).
+	Without extra arguments, it saves the main program.
+	-ofilename	Output to filename instead of STDOUT
+	-v		Verbose (currently gives a few compilation statistics)
+	--		Force end of options
+	-uPackname	Force apparently unused subs from package Packname to
+			be compiled. This allows programs to use eval "foo()"
+			even when sub foo is never seen to be used at compile
+			time. The down side is that any subs which really are
+			never used also have code generated. This option is
+			necessary, for example, if you have a signal handler
+			foo which you initialise with $SIG{BAR} = "foo".
+			A better fix, though, is just to change it to
+			$SIG{BAR} = \&foo. You can have multiple -u options.
+	-D		Debug options (concat or separate flags like perl -D)
+		o	OPs, prints each OP as it's processed
+		c	COPs, prints COPs as processed (incl. file & line num)
+		A	prints AV information on saving
+		C	prints CV information on saving
+		M	prints MAGIC information on saving
+	-f		Force optimisations on or off one at a time.
+		cog	Copy-on-grow: PVs declared and initialised statically
+		no-cog	No copy-on-grow
+	-On		Optimisation level (n = 0, 1, 2, ...). -O means -O1.
+			Currently, -O1 and higher set -fcog.
+
+Examples
+	perl -MO=C foo.pl > foo.c
+	perl cc_harness -o foo foo.c
+
+	perl -MO=C,-v,-DcA bar.pl > /dev/null
+
+CC backend invocation
+	If there are any non-option arguments, they are taken to be names of
+	subs to be saved. Without extra arguments, it saves the main program.
+	-ofilename	Output to filename instead of STDOUT
+	--		Force end of options
+	-uPackname	Force apparently unused subs from package Packname to
+			be compiled. This allows programs to use eval "foo()"
+			even when sub foo is never seen to be used at compile
+			time. The down side is that any subs which really are
+			never used also have code generated. This option is
+			necessary, for example, if you have a signal handler
+			foo which you initialise with $SIG{BAR} = "foo".
+			A better fix, though, is just to change it to
+			$SIG{BAR} = \&foo. You can have multiple -u options.
+	-mModulename	Instead of generating source for a runnable executable,
+			generate source for an XSUB module. The
+			boot_Modulename function (which DynaLoader can look
+			for) does the appropriate initialisation and runs the
+			main part of the Perl source that is being compiled.
+	-pn		Generate code for perl patchlevel n (e.g. 3 or 4).
+			The default is to generate C code which will link
+			with the currently executing version of perl.
+			running the perl compiler.
+	-D		Debug options (concat or separate flags like perl -D)
+		r	Writes debugging output to STDERR just as it's about
+			to write to the program's runtime (otherwise writes
+			debugging info as comments in its C output).
+		O	Outputs each OP as it's compiled
+		s	Outputs the contents of the shadow stack at each OP
+		p	Outputs the contents of the shadow pad of lexicals as
+			it's loaded for each sub or the main program.
+		q	Outputs the name of each fake PP function in the queue
+			as it's about to processes.
+		l	Output the filename and line number of each original
+			line of Perl code as it's processed (pp_nextstate).
+		t	Outputs timing information of compilation stages
+	-f		Force optimisations on or off one at a time.
+		[
+		cog	Copy-on-grow: PVs declared and initialised statically
+		no-cog	No copy-on-grow
+		These two not in CC yet.
+		]
+		freetmps-each-bblock	Delays FREETMPS from the end of each
+					statement to the end of the each basic
+					block.
+		freetmps-each-loop	Delays FREETMPS from the end of each
+					statement to the end of the group of
+					basic blocks forming a loop. At most
+					one of the freetmps-each-* options can
+					be used.
+		omit-taint		Omits generating code for handling
+					perl's tainting mechanism.
+	-On		Optimisation level (n = 0, 1, 2, ...). -O means -O1.
+			Currently, -O1 sets -ffreetmps-each-bblock and -O2
+			sets -ffreetmps-each-loop.
+
+Example
+	perl -MO=CC,-O2,-ofoo.c foo.pl
+	perl cc_harness -o foo foo.c
+
+	perl -MO=CC,-mFoo,-oFoo.c Foo.pm
+	perl cc_harness -shared -c -o Foo.so Foo.c
+
+
+Bytecode backend invocation
+
+	If there are any non-option arguments, they are taken to be
+	names of objects to be saved (probably doesn't work properly yet).
+	Without extra arguments, it saves the main program.
+	-ofilename	Output to filename instead of STDOUT.
+	--		Force end of options.
+	-f		Force optimisations on or off one at a time.
+			Each can be preceded by no- to turn the option off.
+		compress-nullops
+			Only fills in the necessary fields of ops which have
+			been optimised away by perl's internal compiler.
+		omit-sequence-numbers
+			Leaves out code to fill in the op_seq field of all ops
+			which is only used by perl's internal compiler.
+		bypass-nullops
+			If op->op_next ever points to a NULLOP, replaces the
+			op_next field with the first non-NULLOP in the path
+			of execution.
+		strip-syntax-tree
+			Leaves out code to fill in the pointers which link the
+			internal syntax tree together. They're not needed at
+			run-time but leaving them out will make it impossible
+			to recompile or disassemble the resulting program.
+			It will also stop "goto label" statements from working.
+	-On		Optimisation level (n = 0, 1, 2, ...). -O means -O1.
+			-O1 sets -fcompress-nullops -fomit-sequence numbers.
+			-O6 adds -fstrip-syntax-tree.
+	-D		Debug options (concat or separate flags like perl -D)
+		o	OPs, prints each OP as it's processed.
+		b	print debugging information about bytecompiler progress
+		a	tells the assembler to include source assembler lines
+			in its output as bytecode comments.
+		C	prints each CV taken from the final symbol tree walk.
+	-S		Output assembler source rather than piping it
+			through the assembler and outputting bytecode.
+	-m		Compile as a module rather than a standalone program.
+			Currently this just means that the bytecodes for
+			initialising main_start, main_root and curpad are
+			omitted.
+
+Example
+	perl -MO=Bytecode,-O6,-o,foo.plc foo.pl
+
+	perl -MO=Bytecode,-S foo.pl > foo.S
+	assemble foo.S > foo.plc
+	byteperl foo.plc
+
+	perl -MO=Bytecode,-m,-oFoo.pmc Foo.pm
+
+Backends for debugging
+	perl -MO=Terse,exec foo.pl
+	perl -MO=Debug bar.pl
+
+O module
+	Used with "perl -MO=Backend,foo,bar prog.pl" to invoke the backend
+	B::Backend with options foo and bar. O invokes the sub
+	B::Backend::compile() with arguments foo and bar at BEGIN time.
+	That compile() sub must do any inital argument processing replied.
+	If unsuccessful, it should return a string which O arranges to be
+	printed as an error message followed by a clean error exit. In the
+	normal case where any option processing in compile() is successful,
+	it should return a sub ref (usually a closure) to perform the
+	actual compilation. When O regains control, it ensures that the
+	"-c" option is forced (so that the program being compiled doesn't
+	end up running) and registers an END block to call back the sub ref
+	returned from the backend's compile(). Perl then continues by
+	parsing prog.pl (just as it would with "perl -c prog.pl") and after
+	doing so, assuming there are no parse-time errors, the END block
+	of O gets called and the actual backend compilation happens. Phew.
diff --git a/contrib/perl5/ext/B/O.pm b/contrib/perl5/ext/B/O.pm
new file mode 100644
index 0000000..ad391a3
--- /dev/null
+++ b/contrib/perl5/ext/B/O.pm
@@ -0,0 +1,85 @@
+package O;
+use B qw(minus_c);
+use Carp;    
+
+sub import {
+    my ($class, $backend, @options) = @_;
+    eval "use B::$backend ()";
+    if ($@) {
+	croak "use of backend $backend failed: $@";
+    }
+    my $compilesub = &{"B::${backend}::compile"}(@options);
+    if (ref($compilesub) eq "CODE") {
+	minus_c;
+	eval 'END { &$compilesub() }';
+    } else {
+	die $compilesub;
+    }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+O - Generic interface to Perl Compiler backends
+
+=head1 SYNOPSIS
+
+	perl -MO=Backend[,OPTIONS] foo.pl
+
+=head1 DESCRIPTION
+
+This is the module that is used as a frontend to the Perl Compiler.
+
+=head1 CONVENTIONS
+
+Most compiler backends use the following conventions: OPTIONS
+consists of a comma-separated list of words (no white-space).
+The C<-v> option usually puts the backend into verbose mode.
+The C<-ofile> option generates output to B<file> instead of
+stdout. The C<-D> option followed by various letters turns on
+various internal debugging flags. See the documentation for the
+desired backend (named C<B::Backend> for the example above) to
+find out about that backend.
+
+=head1 IMPLEMENTATION
+
+This section is only necessary for those who want to write a
+compiler backend module that can be used via this module.
+
+The command-line mentioned in the SYNOPSIS section corresponds to
+the Perl code
+
+    use O ("Backend", OPTIONS);
+
+The C<import> function which that calls loads in the appropriate
+C<B::Backend> module and calls the C<compile> function in that
+package, passing it OPTIONS. That function is expected to return
+a sub reference which we'll call CALLBACK. Next, the "compile-only"
+flag is switched on (equivalent to the command-line option C<-c>)
+and an END block is registered which calls CALLBACK. Thus the main
+Perl program mentioned on the command-line is read in, parsed and
+compiled into internal syntax tree form. Since the C<-c> flag is
+set, the program does not start running (excepting BEGIN blocks of
+course) but the CALLBACK function registered by the compiler
+backend is called.
+
+In summary, a compiler backend module should be called "B::Foo"
+for some foo and live in the appropriate directory for that name.
+It should define a function called C<compile>. When the user types
+
+    perl -MO=Foo,OPTIONS foo.pl
+
+that function is called and is passed those OPTIONS (split on
+commas). It should return a sub ref to the main compilation function.
+After the user's program is loaded and parsed, that returned sub ref
+is invoked which can then go ahead and do the compilation, usually by
+making use of the C<B> module's functionality.
+
+=head1 AUTHOR
+
+Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
+
+=cut
diff --git a/contrib/perl5/ext/B/README b/contrib/perl5/ext/B/README
new file mode 100644
index 0000000..4e4ed25
--- /dev/null
+++ b/contrib/perl5/ext/B/README
@@ -0,0 +1,325 @@
+		  Perl Compiler Kit, Version alpha4
+
+		 Copyright (c) 1996, 1997, Malcolm Beattie
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of either:
+
+	a) the GNU General Public License as published by the Free
+	Software Foundation; either version 1, or (at your option) any
+	later version, or
+
+	b) the "Artistic License" which comes with this kit.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See either
+    the GNU General Public License or the Artistic License for more details.
+
+    You should have received a copy of the Artistic License with this kit,
+    in the file named "Artistic".  If not, you can get one from the Perl
+    distribution. You should also have received a copy of the GNU General
+    Public License, in the file named "Copying". If not, you can get one
+    from the Perl distribution or else write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+CHANGES
+
+New since alpha3
+    Anonymous subs work properly with C and CC.
+    Heuristics for forcing compilation of apparently unused subs/methods.
+    Subs which use the AutoLoader module are forcibly loaded at compile-time.
+    Slightly faster compilation.
+    Handles slightly more complex code within a BEGIN { }.
+    Minor bug fixes.
+
+New since alpha2
+    CC backend now supports ".." and s//e.
+    Xref backend generates cross-reference reports
+    Cleanups to fix benign but irritating "-w" warnings
+    Minor cxstack fix
+New since alpha1
+    Working CC backend
+    Shared globs and pre-initialised hash support
+    Some XSUB support
+    Assorted bug fixes
+
+INSTALLATION
+
+(1) You need perl5.002 or later.
+
+(2) If you want to compile and run programs with the C or CC backends
+which undefine (or redefine) subroutines, then you need to apply a
+one-line patch to perl itself. One or two of the programs in perl's
+own test suite do this. The patch is in file op.patch. It prevents
+perl from calling free() on OPs with the magic sequence number (U16)-1.
+The compiler declares all OPs as static structures and uses that magic
+sequence number.
+
+(3) Type
+    perl Makefile.PL
+to write a personalised Makefile for your system. If you want the
+bytecode modules to support reading bytecode from strings (instead of
+just from files) then add the option
+    -DINDIRECT_BGET_MACROS
+into the middle of the definition of the CCCMD macro in the Makefile.
+Your C compiler may need to be able to cope with Standard C for this.
+I haven't tested this option yet with an old pre-Standard compiler.
+
+(4) If your platform supports dynamic loading then just type
+    make
+and you can then use
+    perl -Iblib/arch -MO=foo bar
+to use the compiler modules (see later for details).
+If you need/want instead to make a statically linked perl which
+contains the appropriate modules, then type
+    make perl
+    make byteperl
+and you can then use
+    ./perl -MO=foo bar
+to use the compiler modules.    
+In both cases, the byteperl executable is required for running standalone
+bytecode programs. It is *not* a standard perl+XSUB perl executable.
+
+USAGE
+
+As of the alpha3 release, the Bytecode, C and CC backends are now all
+functional enough to compile almost the whole of the main perl test
+suite. In the case of the CC backend, any failures are all due to
+differences and/or known bugs documented below. See the file TESTS.
+In the following examples, you'll need to replace "perl" by
+    perl -Iblib/arch
+if you have built the extensions for a dynamic loading platform but
+haven't installed the extensions completely. You'll need to replace
+"perl" by
+    ./perl
+if you have built the extensions into a statically linked perl binary.
+
+(1) To compile perl program foo.pl with the C backend, do
+    perl -MO=C,-ofoo.c foo.pl
+Then use the cc_harness perl program to compile the resulting C source:
+    perl cc_harness -O2 -o foo foo.c
+
+If you are using a non-ANSI pre-Standard C compiler that can't handle
+pre-declaring static arrays, then add -DBROKEN_STATIC_REDECL to the
+options you use:
+    perl cc_harness -O2 -o foo -DBROKEN_STATIC_REDECL foo.c
+If you are using a non-ANSI pre-Standard C compiler that can't handle
+static initialisation of structures with union members then add
+-DBROKEN_UNION_INIT to the options you use. If you want command line
+arguments passed to your executable to be interpreted by perl (e.g. -Dx)
+then compile foo.c with -DALLOW_PERL_OPTIONS. Otherwise, all command line
+arguments passed to foo will appear directly in @ARGV.  The resulting
+executable foo is the compiled version of foo.pl. See the file NOTES for
+extra options you can pass to -MO=C.
+
+There are some constraints on the contents on foo.pl if you want to be
+able to compile it successfully. Some problems can be fixed fairly easily
+by altering foo.pl; some problems with the compiler are known to be
+straightforward to solve and I'll do so soon. The file Todo lists a
+number of known problems. See the XSUB section lower down for information
+about compiling programs which use XSUBs.
+
+(2) To compile foo.pl with the CC backend (which generates actual
+optimised C code for the execution path of your perl program), use
+    perl -MO=CC,-ofoo.c foo.pl
+
+and proceed just as with the C backend. You should almost certainly
+use an option such as -O2 with the subsequent cc_harness invocation
+so that your C compiler uses optimisation. The C code generated by
+the Perl compiler's CC backend looks ugly to humans but is easily
+optimised by C compilers.
+
+To make the most of this compiler backend, you need to tell the
+compiler when you're using int or double variables so that it can
+optimise appropriately (although this part of the compiler is the most
+buggy). You currently do that by naming lexical variables ending in
+"_i" for ints, "_d" for doubles, "_ir" for int "register" variables or
+"_dr" for double "register" variables. Here "register" is a promise
+that you won't pass a reference to the variable into a sub which then
+modifies the variable. The compiler ought to catch attempts to use
+"\$i" just as C compilers catch attempts to do "&i" for a register int
+i but it doesn't at the moment. Bugs in the CC backend may make your
+program fail in mysterious ways and give wrong answers rather than just
+crash in boring ways. But, hey, this is an alpha release so you knew
+that anyway. See the XSUB section lower down for information about
+compiling programs which use XSUBs.
+
+If your program uses classes which define methods (or other subs which
+are not exported and not apparently used until runtime) then you'll
+need to use -u compile-time options (see the NOTES file) to force the
+subs to be compiled. Future releases will probably default the other
+way, do more auto-detection and provide more fine-grained control.
+
+Since compiled executables need linking with libperl, you may want
+to turn libperl.a into a shared library if your platform supports
+it. For example, with Digital UNIX, do something like
+    ld -shared -o libperl.so -all libperl.a -none -lc
+and with Linux/ELF, rebuild the perl .c files with -fPIC (and I
+also suggest -fomit-frame-pointer for Linux on Intel architetcures),
+do "make libperl.a" and then do
+    gcc -shared -Wl,-soname,libperl.so.5 -o libperl.so.5.3 `ar t libperl.a`
+and then
+    # cp libperl.so.5.3 /usr/lib
+    # cd /usr/lib
+    # ln -s libperl.so.5.3 libperl.so.5
+    # ln -s libperl.so.5 libperl.so
+    # ldconfig
+When you compile perl executables with cc_harness, append -L/usr/lib
+otherwise the -L for the perl source directory will override it. For
+example,
+    perl -Iblib/arch -MO=CC,-O2,-ofoo3.c foo3.bench
+    perl cc_harness -o foo3 -O2 foo3.c -L/usr/lib
+    ls -l foo3
+    -rwxr-xr-x   1 mbeattie xzdg        11218 Jul  1 15:28 foo3
+You'll probably also want to link your main perl executable against
+libperl.so; it's nice having an 11K perl executable.
+
+(3) To compile foo.pl into bytecode do
+    perl -MO=Bytecode,-ofoo foo.pl
+To run the resulting bytecode file foo as a standalone program, you
+use the program byteperl which should have been built along with the
+extensions.
+    ./byteperl foo
+Any extra arguments are passed in as @ARGV; they are not interpreted
+as perl options. If you want to load chunks of bytecode into an already
+running perl program then use the -m option and investigate the
+byteload_fh and byteload_string functions exported by the B module.
+See the NOTES file for details of these and other options (including
+optimisation options and ways of getting at the intermediate "assembler"
+code that the Bytecode backend uses).
+
+(3) There are little Bourne shell scripts and perl programs to aid with
+some common operations: assemble, disassemble, run_bytecode_test,
+run_test, cc_harness, test_harness, test_harness_bytecode.
+
+(4) Walk the op tree in execution order printing terse info about each op
+    perl -MO=Terse,exec foo.pl
+
+(5) Walk the op tree in syntax order printing lengthier debug info about
+each op. You can also append ",exec" to walk in execution order, but the
+formatting is designed to look nice with Terse rather than Debug.
+    perl -MO=Debug foo.pl
+
+(6) Produce a cross-reference report of the line numbers at which all
+variables, subs and formats are defined and used.
+    perl -MO=Xref foo.pl
+
+XSUBS
+
+The C and CC backends can successfully compile some perl programs which
+make use of XSUB extensions. [I'll add more detail to this section in a
+later release.] As a prerequisite, such extensions must not need to do
+anything in their BOOT: section which needs to be done at runtime rather
+than compile time. Normally, the only code in the boot_Foo() function is
+a list of newXS() calls which xsubpp puts there and the compiler handles
+saving those XS subs itself. For each XSUB used, the C and CC compiler
+will generate an initialiser in their C output which refers to the name
+of the relevant C function (XS_Foo_somesub). What is not yet automated
+is the necessary commands and cc command-line options (e.g. via
+"perl cc_harness") which link against the extension libraries. For now,
+you need the XSUB extension to have installed files in the right format
+for using as C libraries (e.g. Foo.a or Foo.so). As the Foo.so files (or
+your platform's version) aren't suitable for linking against, you will
+have to reget the extension source and rebuild it as a static extension
+to force the generation of a suitable Foo.a file. Then you need to make
+a symlink (or copy or rename) of that file into a libFoo.a suitable for
+cc linking. Then add the appropriate -L and -l options to your
+"perl cc_harness" command line to find and link against those libraries.
+You may also need to fix up some platform-dependent environment variable
+to ensure that linked-against .so files are found at runtime too.
+
+DIFFERENCES
+
+The result of running a compiled Perl program can sometimes be different
+from running the same program with standard perl. Think of the compiler
+as having a slightly different implementation of the language Perl.
+Unfortunately, since Perl has had a single implementation until now,
+there are no formal standards or documents defining what behaviour is
+guaranteed of Perl the language and what just "happens to work".
+Some of the differences below are almost impossible to change because of
+the way the compiler works. Others can be changed to produce "standard"
+perl behaviour if it's deemed proper and the resulting performance hit
+is accepted. I'll use "standard perl" to mean the result of running a
+Perl program using the perl executable from the perl distribution.
+I'll use "compiled Perl program" to mean running an executable produced
+by this compiler kit ("the compiler") with the CC backend.
+
+Loops
+    Standard perl calculates the target of "next", "last", and "redo"
+    at run-time. The compiler calculates the targets at compile-time.
+    For example, the program
+
+        sub skip_on_odd { next NUMBER if $_[0] % 2 }
+        NUMBER: for ($i = 0; $i < 5; $i++) {
+            skip_on_odd($i);
+            print $i;
+        }
+
+    produces the output
+        024
+    with standard perl but gives a compile-time error with the compiler.
+
+Context of ".."
+    The context (scalar or array) of the ".." operator determines whether
+    it behaves as a range or a flip/flop. Standard perl delays until
+    runtime the decision of which context it is in but the compiler needs
+    to know the context at compile-time. For example,
+	@a = (4,6,1,0,0,1);
+	sub range { (shift @a)..(shift @a) }
+	print range();
+	while (@a) { print scalar(range()) }
+    generates the output
+        456123E0
+    with standard Perl but gives a compile-time error with compiled Perl.
+
+Arithmetic
+    Compiled Perl programs use native C arithemtic much more frequently
+    than standard perl. Operations on large numbers or on boundary
+    cases may produce different behaviour.
+
+Deprecated features
+    Features of standard perl such as $[ which have been deprecated
+    in standard perl since version 5 was released have not been
+    implemented in the compiler.
+
+Others
+    I'll add to this list as I remember what they are.
+
+BUGS
+
+Here are some things which may cause the compiler problems.
+
+The following render the compiler useless (without serious hacking):
+* Use of the DATA filehandle (via __END__ or __DATA__ tokens)
+* Operator overloading with %OVERLOAD
+* The (deprecated) magic array-offset variable $[ does not work
+* The following operators are not yet implemented for CC
+    goto
+    sort with a non-default comparison (i.e. a named sub or inline block)
+* You can't use "last" to exit from a non-loop block.
+
+The following may give significant problems:
+* BEGIN blocks containing complex initialisation code
+* Code which is only ever referred to at runtime (e.g. via eval "..." or
+  via method calls): see the -u option for the C and CC backends.
+* Run-time lookups of lexical variables in "outside" closures
+
+The following may cause problems (not thoroughly tested):
+* Dependencies on whether values of some "magic" Perl variables are
+  determined at compile-time or runtime.
+* For the C and CC backends: compile-time strings which are longer than
+  your C compiler can cope with in a single line or definition.
+* Reliance on intimate details of global destruction
+* For the Bytecode backend: high -On optimisation numbers with code
+  that has complex flow of control.
+* Any "-w" option in the first line of your perl program is seen and
+  acted on by perl itself before the compiler starts. The compiler
+  itself then runs with warnings turned on. This may cause perl to
+  print out warnings about the compiler itself since I haven't tested
+  it thoroughly with warnings turned on.
+
+There is a terser but more complete list in the Todo file.
+
+Malcolm Beattie
+2 September 1996
diff --git a/contrib/perl5/ext/B/TESTS b/contrib/perl5/ext/B/TESTS
new file mode 100644
index 0000000..e050f6c
--- /dev/null
+++ b/contrib/perl5/ext/B/TESTS
@@ -0,0 +1,78 @@
+Test results from compiling t/*/*.t
+		C		Bytecode	CC
+
+base/cond.t	OK		ok		OK
+base/if.t	OK		ok		OK
+base/lex.t	OK		ok		OK
+base/pat.t	OK		ok		OK
+base/term.t	OK		ok		OK
+cmd/elsif.t	OK		ok		OK
+cmd/for.t	OK		ok		ok 1, 2, 3, panic: pp_iter
+cmd/mod.t	OK		ok		ok
+cmd/subval.t	OK		ok		1..34, not ok 27,28 (simply
+						because filename changes).
+cmd/switch.t	OK		ok		ok
+cmd/while.t	OK		ok		ok
+io/argv.t	OK		ok		ok
+io/dup.t	OK		ok		ok
+io/fs.t		OK		ok		ok
+io/inplace.t	OK		ok		ok
+io/pipe.t	OK		ok		ok with -umain
+io/print.t	OK		ok		ok
+io/tell.t	OK		ok		ok
+op/append.t	OK		ok		OK
+op/array.t	OK		ok		1..36, not ok 7,10 (no $[)
+op/auto.t	OK		ok		OK
+op/chop.t	OK		ok		OK
+op/cond.t	OK		ok		OK
+op/delete.t	OK		ok		OK
+op/do.t		OK		ok		OK
+op/each.t	OK		ok		OK
+op/eval.t	OK		ok		ok 1-6 of 16 then exits
+op/exec.t	OK		ok		OK
+op/exp.t	OK		ok		OK
+op/flip.t	OK		ok		OK
+op/fork.t	OK		ok		OK
+op/glob.t	OK		ok		OK
+op/goto.t	OK		ok		1..9, Can't find label label1.
+op/groups.t	OK (s/ucb/bin/ under Linux)	OK 1..0 for now.
+op/index.t	OK		ok		OK
+op/int.t	OK		ok		OK
+op/join.t	OK		ok		OK
+op/list.t	OK		ok		OK
+op/local.t	OK		ok		OK
+op/magic.t	OK		ok		OK
+op/misc.t	no DATA filehandle so succeeds trivially with 1..0
+op/mkdir.t	OK		ok		OK
+op/my.t		OK		ok		OK
+op/oct.t	OK		ok		OK (C large const warnings)
+op/ord.t	OK		ok		OK
+op/overload.t	Mostly not ok	Mostly not ok	C errors.
+op/pack.t	OK		ok		OK
+op/pat.t	omit 26 (reset)	ok		[lots of memory for compile]
+op/push.t	OK		ok		OK
+op/quotemeta.t	OK		ok		OK
+op/rand.t	OK		ok		
+op/range.t	OK		ok		OK
+op/read.t	OK		ok		OK
+op/readdir.t	OK		ok		OK (substcont works too)
+op/ref.t	omits "ok 40" (lex destruction)	ok (Bytecode)
+						CC: need -u for OBJ,BASEOBJ,
+						UNIVERSAL,WHATEVER,main.
+						1..41, ok1-33,36-38,
+						then ok 41, ok 39.DESTROY probs
+op/regexp.t	OK		ok		ok (trivially all eval'd)
+op/repeat.t	OK		ok		ok
+op/sleep.t	OK		ok		ok
+op/sort.t	OK		ok		1..10, ok 1, Out of memory!
+op/split.t	OK		ok		ok
+op/sprintf.t	OK		ok		ok
+op/stat.t	OK		ok		ok
+op/study.t	OK		ok		ok
+op/subst.t	OK		ok		ok
+op/substr.t	OK		ok		ok1-22 except 7-9,11 (all $[)
+op/time.t	OK		ok		ok
+op/undef.t	omit 21		ok		ok
+op/unshift.t	OK		ok		ok
+op/vec.t	OK		ok		ok
+op/write.t	not ok 3 (no CvOUTSIDE lex from runtime eval). CC: 1..3, hang
diff --git a/contrib/perl5/ext/B/Todo b/contrib/perl5/ext/B/Todo
new file mode 100644
index 0000000..495be2e
--- /dev/null
+++ b/contrib/perl5/ext/B/Todo
@@ -0,0 +1,37 @@
+* Fixes
+
+CC backend: goto, sort with non-default comparison. last for non-loop blocks.
+Version checking
+improve XSUB handling (both static and dynamic)
+sv_magic can do SvREFCNT_inc(obj) which messes up precalculated refcounts
+allocation of XPV[INAHC]V structures needs fixing: Perl tries to free
+them whereas the compiler expects them to be linked to a xpv[inahc]v_root
+list the same as X[IPR]V structures.
+ref counts
+perl_parse replacement
+fix cstring for long strings
+compile-time initialisation of AvARRAYs
+signed/unsigned problems with NV (and IV?) initialisation and elsewhere?
+CvOUTSIDE for ordinary subs
+DATA filehandle for standalone Bytecode program (easy)
+DATA filehandle for multiple bytecode-compiled modules (harder)
+DATA filehandle for C-compiled program (yet harder)
+
+* Features
+
+type checking
+compile time v. runtime initialisation
+save PMOPs in compiled form
+selection of what to dump
+options for cutting out line info etc.
+comment output
+shared constants
+module dependencies
+
+* Optimisations
+collapse LISTOPs to UNOPs or BASEOPs
+compile-time qw(), constant subs
+global analysis of variables, type hints etc.
+demand-loaded bytecode (leader of each basic block replaced by an op
+which loads in bytecode for its block)
+fast sub calls for CC backend
diff --git a/contrib/perl5/ext/B/byteperl.c b/contrib/perl5/ext/B/byteperl.c
new file mode 100644
index 0000000..6b53e3b
--- /dev/null
+++ b/contrib/perl5/ext/B/byteperl.c
@@ -0,0 +1,110 @@
+#include "EXTERN.h"
+#include "perl.h"
+#ifndef PATCHLEVEL
+#include "patchlevel.h"
+#endif
+
+static void xs_init _((void));
+static PerlInterpreter *my_perl;
+
+int
+#ifndef CAN_PROTOTYPE
+main(argc, argv, env)
+int argc;
+char **argv;
+char **env;
+#else  /* def(CAN_PROTOTYPE) */
+main(int argc, char **argv, char **env)
+#endif  /* def(CAN_PROTOTYPE) */
+{
+    int exitstatus;
+    int i;
+    char **fakeargv;
+    FILE *fp;
+#ifdef INDIRECT_BGET_MACROS
+    struct bytestream bs;
+#endif /* INDIRECT_BGET_MACROS */
+
+    INIT_SPECIALSV_LIST;
+    PERL_SYS_INIT(&argc,&argv);
+ 
+#if PATCHLEVEL > 3 || (PATCHLEVEL == 3 && SUBVERSION >= 1)
+    perl_init_i18nl10n(1);
+#else
+    perl_init_i18nl14n(1);
+#endif
+
+    if (!PL_do_undump) {
+	my_perl = perl_alloc();
+	if (!my_perl)
+#ifdef VMS
+	    exit(vaxc$errno);
+#else
+	    exit(1);
+#endif
+	perl_construct( my_perl );
+    }
+
+#ifdef CSH
+    if (!PL_cshlen) 
+      PL_cshlen = strlen(PL_cshname);
+#endif
+
+    if (argc < 2)
+	fp = stdin;
+    else {
+#ifdef WIN32
+	fp = fopen(argv[1], "rb");
+#else
+	fp = fopen(argv[1], "r");
+#endif
+	if (!fp) {
+	    perror(argv[1]);
+#ifdef VMS
+	    exit(vaxc$errno);
+#else
+	    exit(1);
+#endif
+	}
+	argv++;
+	argc--;
+    }
+    New(666, fakeargv, argc + 4, char *);
+    fakeargv[0] = argv[0];
+    fakeargv[1] = "-e";
+    fakeargv[2] = "";
+    fakeargv[3] = "--";
+    for (i = 1; i < argc; i++)
+	fakeargv[i + 3] = argv[i];
+    fakeargv[argc + 3] = 0;
+    
+    exitstatus = perl_parse(my_perl, xs_init, argc + 3, fakeargv, NULL);
+    if (exitstatus)
+	exit( exitstatus );
+
+    sv_setpv(GvSV(gv_fetchpv("0", TRUE, SVt_PV)), argv[0]);
+    PL_main_cv = PL_compcv;
+    PL_compcv = 0;
+
+#ifdef INDIRECT_BGET_MACROS
+    bs.data = fp;
+    bs.fgetc = (int(*) _((void*)))fgetc;
+    bs.fread = (int(*) _((char*,size_t,size_t,void*)))fread;
+    bs.freadpv = freadpv;
+    byterun(bs);
+#else    
+    byterun(fp);
+#endif /* INDIRECT_BGET_MACROS */
+    
+    exitstatus = perl_run( my_perl );
+
+    perl_destruct( my_perl );
+    perl_free( my_perl );
+
+    exit( exitstatus );
+}
+
+static void
+xs_init()
+{
+}
diff --git a/contrib/perl5/ext/B/ramblings/cc.notes b/contrib/perl5/ext/B/ramblings/cc.notes
new file mode 100644
index 0000000..47bd65a
--- /dev/null
+++ b/contrib/perl5/ext/B/ramblings/cc.notes
@@ -0,0 +1,32 @@
+At entry to each basic block, the following can be assumed (and hence
+must be forced where necessary at the end of each basic block):
+
+The shadow stack @stack is empty.
+For each lexical object in @pad, VALID_IV holds for each T_INT,
+VALID_DOUBLE holds for each T_DOUBLE and VALID_SV holds otherwise.
+The C shadow variable sp holds the stack pointer (not necessarily stack_sp).
+
+write_back_stack
+    Writes the contents of the shadow stack @stack back to the real stack.
+    A write-back of each object in the stack is forced so that its
+    backing SV contains the right value and that SV is then pushed onto the
+    real stack. On return, @stack is empty.
+
+write_back_lexicals
+    Forces a write-back (i.e. achieves VALID_SV), where necessary, for each
+    lexical object in @pad. Objects with the TEMPORARY flag are skipped. If
+    write_back_lexicals is called with an (optional) argument, then it is
+    taken to be a bitmask of more flags: any lexical object with one of those
+    flags set is also skipped and not written back to its SV.
+
+invalidate_lexicals($avoid)
+    The VALID_INT and VALID_DOUBLE flags are turned off for each lexical
+    object in @pad whose flags field doesn't overlap with $avoid.
+
+reload_lexicals
+    For each necessary lexical object in @pad, makes sure that VALID_IV
+    holds for objects of type T_INT, VALID_DOUBLE holds for objects for
+    type T_DOUBLE, and VALID_SV holds for other objects. An object is
+    considered for reloading if its flags field does not overlap with the
+    (optional) argument passed to reload_lexicals.
+
diff --git a/contrib/perl5/ext/B/ramblings/curcop.runtime b/contrib/perl5/ext/B/ramblings/curcop.runtime
new file mode 100644
index 0000000..9b8b7d5
--- /dev/null
+++ b/contrib/perl5/ext/B/ramblings/curcop.runtime
@@ -0,0 +1,39 @@
+PP code uses of curcop
+----------------------
+
+pp_rv2gv
+	when a new glob is created for an OPpLVAL_INTRO,
+	curcop->cop_line is stored as GvLINE() in the new GP.
+pp_bless
+	curcop->cop_stash is used as the stash in the one-arg form of bless
+
+pp_repeat
+	tests (curcop != &compiling) to warn "Can't x= to readonly value"
+
+pp_pos
+pp_substr
+pp_index
+pp_rindex
+pp_aslice
+pp_lslice
+pp_splice
+	curcop->cop_arybase
+
+pp_sort
+	curcop->cop_stash used to determine whether to gv_fetchpv $a and $b
+
+pp_caller
+	tests (curcop->cop_stash == debstash) to determine whether
+	to set DB::args
+
+pp_reset
+	resets vars in curcop->cop_stash
+
+pp_dbstate
+	sets curcop = (COP*)op
+
+doeval
+	compiles into curcop->cop_stash
+
+pp_nextstate
+	sets curcop = (COP*)op
diff --git a/contrib/perl5/ext/B/ramblings/flip-flop b/contrib/perl5/ext/B/ramblings/flip-flop
new file mode 100644
index 0000000..183d541
--- /dev/null
+++ b/contrib/perl5/ext/B/ramblings/flip-flop
@@ -0,0 +1,51 @@
+PP(pp_range)
+{
+    if (GIMME == G_ARRAY)
+        return cCONDOP->op_true;
+    return SvTRUEx(PAD_SV(op->op_targ)) ? cCONDOP->op_false : cCONDOP->op_true;
+}
+
+pp_range is a CONDOP.
+In array context, it just returns op_true.
+In scalar context it checks the truth of targ and returns
+op_false if true, op_true if false.
+
+flip is an UNOP.
+It "looks after" its child which is always a pp_range CONDOP.
+In array context, it just returns the child's op_false.
+In scalar context, there are three possible outcomes:
+  (1) set child's targ to 1, our targ to 1 and return op_next.
+  (2) set child's targ to 1, our targ to 0, sp-- and return child's op_false.
+  (3) Blank targ and  TOPs and return op_next.
+Case 1 happens for a "..." with a matching lineno... or true TOPs.
+Case 2 happens for a ".." with a matching lineno... or true TOPs.
+Case 3 happens for a non-matching lineno or false TOPs.
+
+               $a = lhs..rhs;
+
+        ,------->  range
+        ^         /     \
+        |    true/       \false
+        |       /         \
+   first|     lhs        rhs
+        |      \   first   /
+        ^--- flip <----- flop
+                 \       /
+                  \     /
+                  sassign
+
+
+/* range */
+if (SvTRUE(curpad[op->op_targ]))
+    goto label(op_false);
+/* op_true */
+...
+/* flip */
+/* For "..." returns op_next. For ".." returns op_next or op_first->op_false */
+/* end of basic block */
+goto out;
+label(range op_false):
+...
+/* flop */
+out:
+...
diff --git a/contrib/perl5/ext/B/ramblings/magic b/contrib/perl5/ext/B/ramblings/magic
new file mode 100644
index 0000000..e41930a
--- /dev/null
+++ b/contrib/perl5/ext/B/ramblings/magic
@@ -0,0 +1,93 @@
+sv_magic()
+----------
+av.c
+av_store()
+	Storing a non-undef element into an SMAGICAL array, av,
+	assigns the equivalent lowercase form of magic (of the first
+	MAGIC in the chain) to the value (with obj = av, name = 0 and
+	namlen = array index).
+
+gv.c
+gv_init()
+	Initialising gv assigns '*' magic to it with obj = gv, name =
+	GvNAME and namlen = GvNAMELEN.
+gv_fetchpv()
+	@ISA gets 'I' magic with obj = gv, zero name and namlen.
+	%OVERLOAD gets 'A' magic with obj = gv, zero name and namlen.
+	$1 to $9, $&, $`, $', $+ get '\0' magic with obj = gv,
+	name = GvNAME and namlen = len ( = 1 presumably).
+Gv_AMupdate()
+	Stashes for overload magic seem to get 'c' magic with obj = 0,
+	name = &amt and namlen = sizeof(amt).
+hv_magic(hv, gv, how)
+	Gives magic how to hv with obj = gv and zero name and namlen.
+
+mg.c
+mg_copy(sv, nsv, key, klen)
+	Traverses the magic chain of sv. Upper case forms of magic
+	(only) are copied across to nsv, preserving obj but using
+	name = key and namlen = klen.
+magic_setpos()
+	LvTARG of a PVLV gets 'g' magic with obj = name = 0 and namlen = pos.
+
+op.c
+mod()
+	PVLV operators give magic to their targs with
+	obj = name = namlen = 0. OP_POS gives '.', OP_VEC gives 'v'
+	and OP_SUBSTR gives 'x'.
+
+perl.c
+magicname(sym, name, namlen)
+	Fetches/creates a GV with name sym and gives it '\0' magic
+	with obj = gv, name and namlen as passed.
+init_postdump_symbols()
+	Elements of the environment get given SVs with 'e' magic.
+	obj = sv and name and namlen point to the actual string
+	within env.
+
+pp.c
+pp_av2arylen()
+	$#foo gives '#' magic to the new SV with obj = av and
+	name = namlen = 0.
+pp_study()
+	SV gets 'g' magic with obj = name = namlen = 0.
+pp_substr()
+	PVLV gets 'x' magic with obj = name = namlen = 0.
+pp_vec()
+	PVLV gets 'x' magic with obj = name = namlen = 0.
+
+pp_hot.c
+pp_match()
+	m//g gets 'g' magic with obj = name = namlen = 0.
+
+pp_sys.c
+pp_tie()
+	sv gets magic with obj = sv and name = namlen = 0.
+	If an HV or an AV, it gets 'P' magic, otherwise 'q' magic.
+pp_dbmopen()
+	'P' magic for the HV just as with pp_tie().
+pp_sysread()
+	If tainting, the buffer SV gets 't' magic with
+	obj = name = namlen = 0.
+
+sv.c
+sv_setsv()
+	Doing sv_setsv(dstr, gv) gives '*' magic to dstr with
+	obj = dstr, name = GvNAME, namlen = GvNAMELEN.
+
+util.c
+fbm_compile()
+	The PVBM gets 'B' magic with obj = name = namlen = 0 and SvVALID
+	is set to indicate that the Boyer-Moore table is valid.
+	magic_setbm() just clears the SvVALID flag.
+
+hv_magic()
+----------
+
+gv.c
+gv_fetchfile()
+	With perldb, the HV of a gvfile gv gets 'L' magic with obj = gv.
+gv_fetchpv()
+	%SIG gets 'S' magic with obj = siggv.
+init_postdump_symbols()
+	%ENV gets 'E' magic with obj = envgv.
diff --git a/contrib/perl5/ext/B/ramblings/reg.alloc b/contrib/perl5/ext/B/ramblings/reg.alloc
new file mode 100644
index 0000000..7fd69f2
--- /dev/null
+++ b/contrib/perl5/ext/B/ramblings/reg.alloc
@@ -0,0 +1,32 @@
+while ($i--) {
+    foo();
+}
+exit
+
+    PP code			if i an int register	if i an int but not a
+				(i.e. can't be		register (i.e. can be
+				implicitly invalidated)	implicitly invalidated)
+    nextstate
+    enterloop
+
+							
+  loop:
+    gvsv  GV (0xe6078) *i	validates i		validates i
+    postdec			invalidates $i		invalidates $i
+    and if_false goto out;
+				i valid; $i invalid	i valid; $i invalid
+
+				i valid; $i invalid	i valid; $i invalid
+    nextstate
+    pushmark
+    gv  GV (0xe600c) *foo
+    entersub						validates $i; invals i
+
+    unstack
+    goto loop:
+
+				i valid; $i invalid
+  out:
+    leaveloop
+    nextstate
+    exit
diff --git a/contrib/perl5/ext/B/ramblings/runtime.porting b/contrib/perl5/ext/B/ramblings/runtime.porting
new file mode 100644
index 0000000..4699b25
--- /dev/null
+++ b/contrib/perl5/ext/B/ramblings/runtime.porting
@@ -0,0 +1,350 @@
+Notes on porting the perl runtime PP engine.
+Importance: 1 = who cares?, 10 = vital
+Difficulty: 1 = trivial, 10 = very difficult. Level assumes a
+reasonable implementation of the SV and OP API already ported.
+
+OP		Import	Diff	Comments
+null		10	1
+stub		10	1
+scalar		10	1
+pushmark	10	1	PUSHMARK
+wantarray	7	3	cxstack, dopoptosub
+const		10	1	
+gvsv		10	1	save_scalar
+gv		10	1	
+gelem		3	3	
+padsv		10	2	SAVECLEARSV, provide_ref
+padav		10	2
+padhv		10	2
+padany		1	1
+pushre		7	3	pushes an op. Blech.
+rv2gv		6	5
+rv2sv		10	4
+av2arylen	7	3	sv_magic	
+rv2cv		8	5	sv_2cv
+anoncode	7	6	cv_clone
+prototype	4	4	sv_2cv
+refgen		8	3
+srefgen		8	2
+ref		8	3
+bless		7	3
+backtick	5	4
+glob		5	2	do_readline
+readline	8	2	do_readline	
+rcatline	8	2
+regcmaybe	8	1
+regcomp		8	9	pregcomp
+match		8	10
+subst		8	10
+substcont	8	7
+trans		7	4	do_trans
+sassign		10	3	mg_find, SvSETMAGIC
+aassign		10	5	
+chop		8	3	do_chop
+schop		8	3	do_chop
+chomp		8	3	do_chomp
+schomp		8	3	do_chomp
+defined		10	2
+undef		10	3
+study		4	5
+pos		8	3	PVLV, mg_find
+preinc		10	2	sv_inc, SvSETMAGIC
+i_preinc
+predec		10	2	sv_dec, SvSETMAGIC
+i_predec
+postinc		10	2	sv_dec, SvSETMAGIC
+i_postinc
+postdec		10	2	sv_dec, SvSETMAGIC
+i_postdec
+pow		10	1
+multiply	10	1
+i_multiply	10	1
+divide		10	2
+i_divide	10	1
+modulo		10	2
+i_modulo	10	1
+repeat		6	4
+add		10	1
+i_add		10	1
+subtract	10	1
+i_subtract	10	1
+concat		10	2	mg_get
+stringify	10	2	sv_setpvn
+left_shift	10	1
+right_shift	10	1
+lt		10	1
+i_lt		10	1
+gt		10	1
+i_gt		10	1
+le		10	1
+i_le		10	1
+ge		10	1
+i_ge		10	1
+eq		10	1
+i_eq		10	1
+ne		10	1
+i_ne		10	1
+ncmp		10	1
+i_ncmp		10	1
+slt		10	2
+sgt		10	2
+sle		10	2
+sge		10	2
+seq		10	2	sv_eq
+sne		10	2
+scmp		10	2
+bit_and		10	2
+bit_xor		10	2
+bit_or		10	2
+negate		10	3
+i_negate	10	1
+not		10	1
+complement	10	3
+atan2		6	1
+sin		6	1
+cos		6	1
+rand		5	2
+srand		5	2
+exp		6	1
+log		6	2
+sqrt		6	2
+int		10	2
+hex		9	2
+oct		9	2
+abs		10	1
+length		10	1
+substr		10	4	PVLV
+vec		5	4
+index		9	3
+rindex		9	3
+sprintf		9	4	do_sprintf
+formline	6	7
+ord		6	2	
+chr		6	2
+crypt		3	2
+ucfirst		6	2
+lcfirst		6	2
+uc		6	2
+lc		6	2
+quotemeta	6	3
+rv2av		10	3	save_svref, mg_get, save_ary
+aelemfast	10	2	av_fetch
+aelem		10	3
+aslice		9	4
+each		10	3	hv_iternext
+values		10	3	do_kv
+keys		10	3	do_kv
+delete		10	3
+exists		10	3
+rv2hv		10	3	save_svref, mg_get, save_ary, do_kv
+helem		10	3	save_svref, provide_ref
+hslice		9	4
+unpack		9	6	lengthy
+pack		9	6	lengthy
+split		9	9
+join		10	4	do_join
+list		10	2
+lslice		9	4
+anonlist	10	2
+anonhash	10	3
+splice		9	6
+push		10	2
+pop		10	2
+shift		10	2
+unshift		10	2
+sort		6	7
+reverse		9	4
+grepstart	6	5	modifies flow of control
+grepwhile	6	5	modifies flow of control
+mapstart	1	1
+mapwhile	6	5	modifies flow of control
+range		7	3	modifies flow of control
+flip		7	4	modifies flow of control
+flop		7	4	modifies flow of control
+and		10	3	modifies flow of control
+or		10	3	modifies flow of control
+xor
+cond_expr	10	3	modifies flow of control
+andassign	7	3	modifies flow of control
+orassign	7	3	modifies flow of control
+method		8	5
+entersub	10	7
+leavesub	10	5
+caller		2	8
+warn		9	3
+die		9	3
+reset		2	2
+lineseq		1	1
+nextstate	10	1	Update stack_sp from cxstack. FREETMPS.
+dbstate		3	7		
+unstack
+enter		10	3	cxstack, ENTER, SAVETMPS, PUSHBLOCK
+leave		10	3	cxstack, SAVETMPS, LEAVE, POPBLOCK
+scope		1	1
+enteriter	9	4	cxstack
+iter		9	3	cxstack
+enterloop	10	4
+leaveloop	10	4
+return		10	5
+last		9	6
+next		9	6
+redo		9	6
+dump		1	9	pp_goto
+goto		6	9
+exit		9	2	my_exit
+open		9	5	do_open
+close		9	3	do_close
+pipe_op		7	4
+fileno		9	2
+umask		4	2
+binmode		4	2
+tie		5	5	pp_entersub
+untie		5	2	sv_unmagic
+tied		5	2
+dbmopen		4	5
+dbmclose	4	2
+sselect		4	4
+select		7	3
+getc		7	2
+read		8	2	pp_sysread
+enterwrite	4	4	doform
+leavewrite	4	5
+prtf		4	4	do_sprintf
+print		8	6
+sysopen		8	2
+sysread		8	4
+syswrite	8	4	pp_send
+send		8	4
+recv		8	4	pp_sysread
+eof		9	2
+tell		9	3
+seek		9	2
+truncate	8	3
+fcntl		8	4	pp_ioctl
+ioctl		8	4
+flock		8	2
+socket		5	3
+sockpair	5	3
+bind		5	3
+connect		5	3
+listen		5	3
+accept		5	3
+shutdown	5	2
+gsockopt	5	3	pp_ssockopt
+ssockopt	5	3
+getsockname	5	3	pp_getpeername
+getpeername	5	3
+lstat		5	4	pp_stat
+stat		5	4	lengthy
+ftrread		5	2	cando
+ftrwrite	5	2	cando
+ftrexec		5	2	cando
+fteread		5	2	cando
+ftewrite	5	2	cando
+fteexec		5	2	cando
+ftis		5	2	cando
+fteowned	5	2	cando
+ftrowned	5	2	cando
+ftzero		5	2	cando
+ftsize		5	2	cando
+ftmtime		5	2	cando
+ftatime		5	2	cando
+ftctime		5	2	cando
+ftsock		5	2	cando
+ftchr		5	2	cando
+ftblk		5	2	cando
+ftfile		5	2	cando
+ftdir		5	2	cando
+ftpipe		5	2	cando
+ftlink		5	2	cando
+ftsuid		5	2	cando
+ftsgid		5	2	cando
+ftsvtx		5	2	cando
+fttty		5	2	cando
+fttext		5	4
+ftbinary	5	4	fttext
+chdir
+chown
+chroot
+unlink
+chmod
+utime
+rename
+link
+symlink
+readlink
+mkdir
+rmdir
+open_dir
+readdir
+telldir
+seekdir
+rewinddir
+closedir
+fork
+wait
+waitpid
+system
+exec
+kill
+getppid
+getpgrp
+setpgrp
+getpriority
+setpriority
+time
+tms
+localtime
+gmtime
+alarm
+sleep
+shmget
+shmctl
+shmread
+shmwrite
+msgget
+msgctl
+msgsnd
+msgrcv
+semget
+semctl
+semop
+require		6	9	doeval
+dofile		6	9	doeval
+entereval	6	9	doeval
+leaveeval	6	5
+entertry	7	4	modifies flow of control
+leavetry	7	3
+ghbyname
+ghbyaddr
+ghostent
+gnbyname
+gnbyaddr
+gnetent
+gpbyname
+gpbynumber
+gprotoent
+gsbyname
+gsbyport
+gservent
+shostent
+snetent
+sprotoent
+sservent
+ehostent
+enetent
+eprotoent
+eservent
+gpwnam
+gpwuid
+gpwent
+spwent
+epwent
+ggrnam
+ggrgid
+ggrent
+sgrent
+egrent
+getlogin
+syscall
+	
\ No newline at end of file
diff --git a/contrib/perl5/ext/B/typemap b/contrib/perl5/ext/B/typemap
new file mode 100644
index 0000000..7206a6a
--- /dev/null
+++ b/contrib/perl5/ext/B/typemap
@@ -0,0 +1,69 @@
+TYPEMAP
+
+B::OP		T_OP_OBJ
+B::UNOP		T_OP_OBJ
+B::BINOP	T_OP_OBJ
+B::LOGOP	T_OP_OBJ
+B::CONDOP	T_OP_OBJ
+B::LISTOP	T_OP_OBJ
+B::PMOP		T_OP_OBJ
+B::SVOP		T_OP_OBJ
+B::GVOP		T_OP_OBJ
+B::PVOP		T_OP_OBJ
+B::CVOP		T_OP_OBJ
+B::LOOP		T_OP_OBJ
+B::COP		T_OP_OBJ
+
+B::SV		T_SV_OBJ
+B::PV		T_SV_OBJ
+B::IV		T_SV_OBJ
+B::NV		T_SV_OBJ
+B::PVMG		T_SV_OBJ
+B::PVLV		T_SV_OBJ
+B::BM		T_SV_OBJ
+B::RV		T_SV_OBJ
+B::GV		T_SV_OBJ
+B::CV		T_SV_OBJ
+B::HV		T_SV_OBJ
+B::AV		T_SV_OBJ
+B::IO		T_SV_OBJ
+
+B::MAGIC	T_MG_OBJ
+SSize_t		T_IV
+STRLEN		T_IV
+
+INPUT
+T_OP_OBJ
+	if (SvROK($arg)) {
+	    IV tmp = SvIV((SV*)SvRV($arg));
+	    $var = ($type) tmp;
+	}
+	else
+	    croak(\"$var is not a reference\")
+
+T_SV_OBJ
+	if (SvROK($arg)) {
+	    IV tmp = SvIV((SV*)SvRV($arg));
+	    $var = ($type) tmp;
+	}
+	else
+	    croak(\"$var is not a reference\")
+
+T_MG_OBJ
+	if (SvROK($arg)) {
+	    IV tmp = SvIV((SV*)SvRV($arg));
+	    $var = ($type) tmp;
+	}
+	else
+	    croak(\"$var is not a reference\")
+
+OUTPUT
+T_OP_OBJ
+	sv_setiv(newSVrv($arg, cc_opclassname((OP*)$var)), (IV)$var);
+
+T_SV_OBJ
+	make_sv_object(($arg), (SV*)($var));
+
+
+T_MG_OBJ
+	sv_setiv(newSVrv($arg, "B::MAGIC"), (IV)$var);
diff --git a/contrib/perl5/ext/DB_File/Changes b/contrib/perl5/ext/DB_File/Changes
new file mode 100644
index 0000000..993fe32
--- /dev/null
+++ b/contrib/perl5/ext/DB_File/Changes
@@ -0,0 +1,205 @@
+
+0.1
+
+    First Release.
+
+0.2
+
+    When DB_File is opening a database file it no longer terminates the
+    process if dbopen returned an error. This allows file protection
+    errors to be caught at run time. Thanks to Judith Grass
+    <grass@cybercash.com> for spotting the bug.
+
+0.3
+
+    Added prototype support for multiple btree compare callbacks.
+
+1.0
+
+    DB_File has been in use for over a year. To reflect that, the
+    version number has been incremented to 1.0.
+
+    Added complete support for multiple concurrent callbacks.
+
+    Using the push method on an empty list didn't work properly. This
+    has been fixed.
+
+1.01
+
+    Fixed a core dump problem with SunOS.
+
+    The return value from TIEHASH wasn't set to NULL when dbopen
+    returned an error.
+
+1.02
+
+    Merged OS/2 specific code into DB_File.xs
+
+    Removed some redundant code in DB_File.xs.
+
+    Documentation update.
+
+    Allow negative subscripts with RECNO interface.
+
+    Changed the default flags from O_RDWR to O_CREAT|O_RDWR.
+
+    The example code which showed how to lock a database needed a call
+    to sync added. Without it the resultant database file was empty.
+
+    Added get_dup method.
+
+1.03
+
+    Documentation update.
+
+    DB_File now imports the constants (O_RDWR, O_CREAT etc.) from Fcntl
+    automatically.
+
+    The standard hash function exists is now supported.
+
+    Modified the behavior of get_dup. When it returns an associative
+    array, the value is the count of the number of matching BTREE
+    values.
+
+1.04
+
+    Minor documentation changes.
+
+    Fixed a bug in hash_cb. Patches supplied by Dave Hammen,
+    <hammen@gothamcity.jsc.nasa.govt>.
+
+    Fixed a bug with the constructors for DB_File::HASHINFO,
+    DB_File::BTREEINFO and DB_File::RECNOINFO. Also tidied up the
+    constructors to make them -w clean.
+
+    Reworked part of the test harness to be more locale friendly.
+
+1.05
+
+    Made all scripts in the documentation strict and -w clean.
+
+    Added logic to DB_File.xs to allow the module to be built after
+    Perl is installed.
+
+1.06
+
+    Minor namespace cleanup: Localized PrintBtree.
+
+1.07
+
+    Fixed bug with RECNO, where bval wasn't defaulting to "\n".
+
+1.08
+
+    Documented operation of bval.
+
+1.09
+
+    Minor bug fix in DB_File::HASHINFO, DB_File::RECNOINFO and
+    DB_File::BTREEINFO.
+
+    Changed default mode to 0666.
+
+1.10
+
+    Fixed fd method so that it still returns -1 for in-memory files
+    when db 1.86 is used.
+
+1.11
+
+    Documented the untie gotcha.
+
+1.12
+
+    Documented the incompatibility with version 2 of Berkeley DB.
+
+1.13
+
+    Minor changes to DB_FIle.xs and DB_File.pm
+
+1.14
+
+    Made it illegal to tie an associative array to a RECNO database and
+    an ordinary array to a HASH or BTREE database.
+
+1.15
+
+    Patch from Gisle Aas <gisle@aas.no> to suppress "use of undefined
+    value" warning with db_get and db_seq.
+
+    Patch from Gisle Aas <gisle@aas.no> to make DB_File export only the
+    O_* constants from Fcntl.
+
+    Removed the DESTROY method from the DB_File::HASHINFO module.
+
+    Previously DB_File hard-wired the class name of any object that it
+    created to "DB_File". This makes sub-classing difficult. Now
+    DB_File creats objects in the namespace of the package it has been
+    inherited into.
+
+
+1.16
+
+   A harmless looking tab was causing Makefile.PL to fail on AIX 3.2.5
+
+    Small fix for the AIX strict C compiler XLC which doesn't like
+    __attribute__ being defined via proto.h and redefined via db.h. Fix
+    courtesy of Jarkko Hietaniemi.
+
+1.50
+
+    DB_File can now build with either DB 1.x or 2.x, but not both at
+    the same time.
+
+1.51
+
+    Fixed the test harness so that it doesn't expect DB_File to have
+    been installed by the main Perl build.
+
+
+    Fixed a bug in mapping 1.x O_RDONLY flag to 2.x DB_RDONLY equivalent
+
+1.52
+
+   Patch from Nick Ing-Simmons now allows DB_File to build on NT.
+   Merged 1.15 patch.
+
+1.53
+
+   Added DB_RENUMBER to flags for recno.
+
+1.54
+
+   Fixed a small bug in the test harness when run under win32
+   The emulation of fd when useing DB 2.x was busted.
+
+1.55
+   Merged 1.16 changes.
+
+1.56
+   Documented the Solaris 2.5 mutex bug
+
+1.57
+   If Perl has been compiled with Threads support,the symbol op will be
+   defined. This clashes with a field name in db.h, so it needs to be
+   #undef'ed before db.h is included.
+
+1.58
+   Tied Array support was enhanced in Perl 5.004_57. DB_File now
+   supports PUSH,POP,SHIFT,UNSHIFT & STORESIZE.
+
+   Fixed a problem with the use of sv_setpvn. When the size is
+   specified as 0, it does a strlen on the data.  This was ok for DB
+   1.x, but isn't for DB 2.x.
+
+1.59
+   Updated the license section.
+
+   Berkeley DB 2.4.10 disallows zero length keys. Tests 32 & 42 in
+   db-btree.t and test 27 in db-hash.t failed because of this change.
+   Those tests have been zapped.
+
+   Added dbinfo to the distribution.
+
+1.60
+   Changed the test to check for full tied array support
diff --git a/contrib/perl5/ext/DB_File/DB_File.pm b/contrib/perl5/ext/DB_File/DB_File.pm
new file mode 100644
index 0000000..fcd0746
--- /dev/null
+++ b/contrib/perl5/ext/DB_File/DB_File.pm
@@ -0,0 +1,1695 @@
+# DB_File.pm -- Perl 5 interface to Berkeley DB 
+#
+# written by Paul Marquess (pmarquess@bfsec.bt.co.uk)
+# last modified 16th May 1998
+# version 1.60
+#
+#     Copyright (c) 1995-8 Paul Marquess. All rights reserved.
+#     This program is free software; you can redistribute it and/or
+#     modify it under the same terms as Perl itself.
+
+
+package DB_File::HASHINFO ;
+
+require 5.003 ;
+
+use strict;
+use Carp;
+require Tie::Hash;
+@DB_File::HASHINFO::ISA = qw(Tie::Hash);
+
+sub new
+{
+    my $pkg = shift ;
+    my %x ;
+    tie %x, $pkg ;
+    bless \%x, $pkg ;
+}
+
+
+sub TIEHASH
+{
+    my $pkg = shift ;
+
+    bless { VALID => { map {$_, 1} 
+		       qw( bsize ffactor nelem cachesize hash lorder)
+		     }, 
+	    GOT   => {}
+          }, $pkg ;
+}
+
+
+sub FETCH 
+{  
+    my $self  = shift ;
+    my $key   = shift ;
+
+    return $self->{GOT}{$key} if exists $self->{VALID}{$key}  ;
+
+    my $pkg = ref $self ;
+    croak "${pkg}::FETCH - Unknown element '$key'" ;
+}
+
+
+sub STORE 
+{
+    my $self  = shift ;
+    my $key   = shift ;
+    my $value = shift ;
+
+    if ( exists $self->{VALID}{$key} )
+    {
+        $self->{GOT}{$key} = $value ;
+        return ;
+    }
+    
+    my $pkg = ref $self ;
+    croak "${pkg}::STORE - Unknown element '$key'" ;
+}
+
+sub DELETE 
+{
+    my $self = shift ;
+    my $key  = shift ;
+
+    if ( exists $self->{VALID}{$key} )
+    {
+        delete $self->{GOT}{$key} ;
+        return ;
+    }
+    
+    my $pkg = ref $self ;
+    croak "DB_File::HASHINFO::DELETE - Unknown element '$key'" ;
+}
+
+sub EXISTS
+{
+    my $self = shift ;
+    my $key  = shift ;
+
+    exists $self->{VALID}{$key} ;
+}
+
+sub NotHere
+{
+    my $self = shift ;
+    my $method = shift ;
+
+    croak ref($self) . " does not define the method ${method}" ;
+}
+
+sub FIRSTKEY { my $self = shift ; $self->NotHere("FIRSTKEY") }
+sub NEXTKEY  { my $self = shift ; $self->NotHere("NEXTKEY") }
+sub CLEAR    { my $self = shift ; $self->NotHere("CLEAR") }
+
+package DB_File::RECNOINFO ;
+
+use strict ;
+
+@DB_File::RECNOINFO::ISA = qw(DB_File::HASHINFO) ;
+
+sub TIEHASH
+{
+    my $pkg = shift ;
+
+    bless { VALID => { map {$_, 1} 
+		       qw( bval cachesize psize flags lorder reclen bfname )
+		     },
+	    GOT   => {},
+          }, $pkg ;
+}
+
+package DB_File::BTREEINFO ;
+
+use strict ;
+
+@DB_File::BTREEINFO::ISA = qw(DB_File::HASHINFO) ;
+
+sub TIEHASH
+{
+    my $pkg = shift ;
+
+    bless { VALID => { map {$_, 1} 
+		       qw( flags cachesize maxkeypage minkeypage psize 
+			   compare prefix lorder )
+	    	     },
+	    GOT   => {},
+          }, $pkg ;
+}
+
+
+package DB_File ;
+
+use strict;
+use vars qw($VERSION @ISA @EXPORT $AUTOLOAD $DB_BTREE $DB_HASH $DB_RECNO $db_version) ;
+use Carp;
+
+
+$VERSION = "1.60" ;
+
+#typedef enum { DB_BTREE, DB_HASH, DB_RECNO } DBTYPE;
+$DB_BTREE = new DB_File::BTREEINFO ;
+$DB_HASH  = new DB_File::HASHINFO ;
+$DB_RECNO = new DB_File::RECNOINFO ;
+
+require Tie::Hash;
+require Exporter;
+use AutoLoader;
+require DynaLoader;
+@ISA = qw(Tie::Hash Exporter DynaLoader);
+@EXPORT = qw(
+        $DB_BTREE $DB_HASH $DB_RECNO 
+
+	BTREEMAGIC
+	BTREEVERSION
+	DB_LOCK
+	DB_SHMEM
+	DB_TXN
+	HASHMAGIC
+	HASHVERSION
+	MAX_PAGE_NUMBER
+	MAX_PAGE_OFFSET
+	MAX_REC_NUMBER
+	RET_ERROR
+	RET_SPECIAL
+	RET_SUCCESS
+	R_CURSOR
+	R_DUP
+	R_FIRST
+	R_FIXEDLEN
+	R_IAFTER
+	R_IBEFORE
+	R_LAST
+	R_NEXT
+	R_NOKEY
+	R_NOOVERWRITE
+	R_PREV
+	R_RECNOSYNC
+	R_SETCURSOR
+	R_SNAPSHOT
+	__R_UNUSED
+
+);
+
+sub AUTOLOAD {
+    my($constname);
+    ($constname = $AUTOLOAD) =~ s/.*:://;
+    my $val = constant($constname, @_ ? $_[0] : 0);
+    if ($! != 0) {
+	if ($! =~ /Invalid/) {
+	    $AutoLoader::AUTOLOAD = $AUTOLOAD;
+	    goto &AutoLoader::AUTOLOAD;
+	}
+	else {
+	    my($pack,$file,$line) = caller;
+	    croak "Your vendor has not defined DB macro $constname, used at $file line $line.
+";
+	}
+    }
+    eval "sub $AUTOLOAD { $val }";
+    goto &$AUTOLOAD;
+}
+
+
+eval {
+    # Make all Fcntl O_XXX constants available for importing
+    require Fcntl;
+    my @O = grep /^O_/, @Fcntl::EXPORT;
+    Fcntl->import(@O);  # first we import what we want to export
+    push(@EXPORT, @O);
+};
+
+## import borrowed from IO::File
+##   exports Fcntl constants if available.
+#sub import {
+#    my $pkg = shift;
+#    my $callpkg = caller;
+#    Exporter::export $pkg, $callpkg, @_;
+#    eval {
+#        require Fcntl;
+#        Exporter::export 'Fcntl', $callpkg, '/^O_/';
+#    };
+#}
+
+bootstrap DB_File $VERSION;
+
+# Preloaded methods go here.  Autoload methods go after __END__, and are
+# processed by the autosplit program.
+
+sub tie_hash_or_array
+{
+    my (@arg) = @_ ;
+    my $tieHASH = ( (caller(1))[3] =~ /TIEHASH/ ) ;
+
+    $arg[4] = tied %{ $arg[4] } 
+	if @arg >= 5 && ref $arg[4] && $arg[4] =~ /=HASH/ && tied %{ $arg[4] } ;
+
+    # make recno in Berkeley DB version 2 work like recno in version 1.
+    if ($db_version > 1 and defined $arg[4] and $arg[4] =~ /RECNO/ and 
+	$arg[1] and ! -e $arg[1]) {
+	open(FH, ">$arg[1]") or return undef ;
+	close FH ;
+	chmod $arg[3] ? $arg[3] : 0666 , $arg[1] ;
+    }
+
+    DoTie_($tieHASH, @arg) ;
+}
+
+sub TIEHASH
+{
+    tie_hash_or_array(@_) ;
+}
+
+sub TIEARRAY
+{
+    tie_hash_or_array(@_) ;
+}
+
+sub CLEAR 
+{
+    my $self = shift;
+    my $key = "" ;
+    my $value = "" ;
+    my $status = $self->seq($key, $value, R_FIRST());
+    my @keys;
+ 
+    while ($status == 0) {
+        push @keys, $key;
+        $status = $self->seq($key, $value, R_NEXT());
+    }
+    foreach $key (reverse @keys) {
+        my $s = $self->del($key); 
+    }
+}
+
+sub EXTEND { }
+
+sub STORESIZE
+{
+    my $self = shift;
+    my $length = shift ;
+    my $current_length = $self->length() ;
+
+    if ($length < $current_length) {
+	my $key ;
+        for ($key = $current_length - 1 ; $key >= $length ; -- $key)
+	  { $self->del($key) }
+    }
+    elsif ($length > $current_length) {
+        $self->put($length-1, "") ;
+    }
+}
+ 
+sub get_dup
+{
+    croak "Usage: \$db->get_dup(key [,flag])\n"
+        unless @_ == 2 or @_ == 3 ;
+ 
+    my $db        = shift ;
+    my $key       = shift ;
+    my $flag	  = shift ;
+    my $value 	  = 0 ;
+    my $origkey   = $key ;
+    my $wantarray = wantarray ;
+    my %values	  = () ;
+    my @values    = () ;
+    my $counter   = 0 ;
+    my $status    = 0 ;
+ 
+    # iterate through the database until either EOF ($status == 0)
+    # or a different key is encountered ($key ne $origkey).
+    for ($status = $db->seq($key, $value, R_CURSOR()) ;
+	 $status == 0 and $key eq $origkey ;
+         $status = $db->seq($key, $value, R_NEXT()) ) {
+ 
+        # save the value or count number of matches
+        if ($wantarray) {
+	    if ($flag)
+                { ++ $values{$value} }
+	    else
+                { push (@values, $value) }
+	}
+        else
+            { ++ $counter }
+     
+    }
+ 
+    return ($wantarray ? ($flag ? %values : @values) : $counter) ;
+}
+
+
+1;
+__END__
+
+=head1 NAME
+
+DB_File - Perl5 access to Berkeley DB version 1.x
+
+=head1 SYNOPSIS
+
+ use DB_File ;
+ 
+ [$X =] tie %hash,  'DB_File', [$filename, $flags, $mode, $DB_HASH] ;
+ [$X =] tie %hash,  'DB_File', $filename, $flags, $mode, $DB_BTREE ;
+ [$X =] tie @array, 'DB_File', $filename, $flags, $mode, $DB_RECNO ;
+
+ $status = $X->del($key [, $flags]) ;
+ $status = $X->put($key, $value [, $flags]) ;
+ $status = $X->get($key, $value [, $flags]) ;
+ $status = $X->seq($key, $value, $flags) ;
+ $status = $X->sync([$flags]) ;
+ $status = $X->fd ;
+
+ # BTREE only
+ $count = $X->get_dup($key) ;
+ @list  = $X->get_dup($key) ;
+ %list  = $X->get_dup($key, 1) ;
+
+ # RECNO only
+ $a = $X->length;
+ $a = $X->pop ;
+ $X->push(list);
+ $a = $X->shift;
+ $X->unshift(list);
+
+ untie %hash ;
+ untie @array ;
+
+=head1 DESCRIPTION
+
+B<DB_File> is a module which allows Perl programs to make use of the
+facilities provided by Berkeley DB version 1.x (if you have a newer
+version of DB, see L<Using DB_File with Berkeley DB version 2>). It is
+assumed that you have a copy of the Berkeley DB manual pages at hand
+when reading this documentation. The interface defined here mirrors the
+Berkeley DB interface closely.
+
+Berkeley DB is a C library which provides a consistent interface to a
+number of database formats.  B<DB_File> provides an interface to all
+three of the database types currently supported by Berkeley DB.
+
+The file types are:
+
+=over 5
+
+=item B<DB_HASH>
+
+This database type allows arbitrary key/value pairs to be stored in data
+files. This is equivalent to the functionality provided by other
+hashing packages like DBM, NDBM, ODBM, GDBM, and SDBM. Remember though,
+the files created using DB_HASH are not compatible with any of the
+other packages mentioned.
+
+A default hashing algorithm, which will be adequate for most
+applications, is built into Berkeley DB. If you do need to use your own
+hashing algorithm it is possible to write your own in Perl and have
+B<DB_File> use it instead.
+
+=item B<DB_BTREE>
+
+The btree format allows arbitrary key/value pairs to be stored in a
+sorted, balanced binary tree.
+
+As with the DB_HASH format, it is possible to provide a user defined
+Perl routine to perform the comparison of keys. By default, though, the
+keys are stored in lexical order.
+
+=item B<DB_RECNO>
+
+DB_RECNO allows both fixed-length and variable-length flat text files
+to be manipulated using the same key/value pair interface as in DB_HASH
+and DB_BTREE.  In this case the key will consist of a record (line)
+number.
+
+=back
+
+=head2 Using DB_File with Berkeley DB version 2
+
+Although B<DB_File> is intended to be used with Berkeley DB version 1,
+it can also be used with version 2. In this case the interface is
+limited to the functionality provided by Berkeley DB 1.x. Anywhere the
+version 2 interface differs, B<DB_File> arranges for it to work like
+version 1. This feature allows B<DB_File> scripts that were built with
+version 1 to be migrated to version 2 without any changes.
+
+If you want to make use of the new features available in Berkeley DB
+2.x, use the Perl module B<BerkeleyDB> instead.
+
+At the time of writing this document the B<BerkeleyDB> module is still
+alpha quality (the version number is < 1.0), and so unsuitable for use
+in any serious development work. Once its version number is >= 1.0, it
+is considered stable enough for real work.
+
+B<Note:> The database file format has changed in Berkeley DB version 2.
+If you cannot recreate your databases, you must dump any existing
+databases with the C<db_dump185> utility that comes with Berkeley DB.
+Once you have upgraded DB_File to use Berkeley DB version 2, your
+databases can be recreated using C<db_load>. Refer to the Berkeley DB
+documentation for further details.
+
+Please read L<COPYRIGHT> before using version 2.x of Berkeley DB with
+DB_File.
+
+=head2 Interface to Berkeley DB
+
+B<DB_File> allows access to Berkeley DB files using the tie() mechanism
+in Perl 5 (for full details, see L<perlfunc/tie()>). This facility
+allows B<DB_File> to access Berkeley DB files using either an
+associative array (for DB_HASH & DB_BTREE file types) or an ordinary
+array (for the DB_RECNO file type).
+
+In addition to the tie() interface, it is also possible to access most
+of the functions provided in the Berkeley DB API directly.
+See L<THE API INTERFACE>.
+
+=head2 Opening a Berkeley DB Database File
+
+Berkeley DB uses the function dbopen() to open or create a database.
+Here is the C prototype for dbopen():
+
+      DB*
+      dbopen (const char * file, int flags, int mode, 
+              DBTYPE type, const void * openinfo)
+
+The parameter C<type> is an enumeration which specifies which of the 3
+interface methods (DB_HASH, DB_BTREE or DB_RECNO) is to be used.
+Depending on which of these is actually chosen, the final parameter,
+I<openinfo> points to a data structure which allows tailoring of the
+specific interface method.
+
+This interface is handled slightly differently in B<DB_File>. Here is
+an equivalent call using B<DB_File>:
+
+        tie %array, 'DB_File', $filename, $flags, $mode, $DB_HASH ;
+
+The C<filename>, C<flags> and C<mode> parameters are the direct
+equivalent of their dbopen() counterparts. The final parameter $DB_HASH
+performs the function of both the C<type> and C<openinfo> parameters in
+dbopen().
+
+In the example above $DB_HASH is actually a pre-defined reference to a
+hash object. B<DB_File> has three of these pre-defined references.
+Apart from $DB_HASH, there is also $DB_BTREE and $DB_RECNO.
+
+The keys allowed in each of these pre-defined references is limited to
+the names used in the equivalent C structure. So, for example, the
+$DB_HASH reference will only allow keys called C<bsize>, C<cachesize>,
+C<ffactor>, C<hash>, C<lorder> and C<nelem>. 
+
+To change one of these elements, just assign to it like this:
+
+	$DB_HASH->{'cachesize'} = 10000 ;
+
+The three predefined variables $DB_HASH, $DB_BTREE and $DB_RECNO are
+usually adequate for most applications.  If you do need to create extra
+instances of these objects, constructors are available for each file
+type.
+
+Here are examples of the constructors and the valid options available
+for DB_HASH, DB_BTREE and DB_RECNO respectively.
+
+     $a = new DB_File::HASHINFO ;
+     $a->{'bsize'} ;
+     $a->{'cachesize'} ;
+     $a->{'ffactor'};
+     $a->{'hash'} ;
+     $a->{'lorder'} ;
+     $a->{'nelem'} ;
+
+     $b = new DB_File::BTREEINFO ;
+     $b->{'flags'} ;
+     $b->{'cachesize'} ;
+     $b->{'maxkeypage'} ;
+     $b->{'minkeypage'} ;
+     $b->{'psize'} ;
+     $b->{'compare'} ;
+     $b->{'prefix'} ;
+     $b->{'lorder'} ;
+
+     $c = new DB_File::RECNOINFO ;
+     $c->{'bval'} ;
+     $c->{'cachesize'} ;
+     $c->{'psize'} ;
+     $c->{'flags'} ;
+     $c->{'lorder'} ;
+     $c->{'reclen'} ;
+     $c->{'bfname'} ;
+
+The values stored in the hashes above are mostly the direct equivalent
+of their C counterpart. Like their C counterparts, all are set to a
+default values - that means you don't have to set I<all> of the
+values when you only want to change one. Here is an example:
+
+     $a = new DB_File::HASHINFO ;
+     $a->{'cachesize'} =  12345 ;
+     tie %y, 'DB_File', "filename", $flags, 0777, $a ;
+
+A few of the options need extra discussion here. When used, the C
+equivalent of the keys C<hash>, C<compare> and C<prefix> store pointers
+to C functions. In B<DB_File> these keys are used to store references
+to Perl subs. Below are templates for each of the subs:
+
+    sub hash
+    {
+        my ($data) = @_ ;
+        ...
+        # return the hash value for $data
+	return $hash ;
+    }
+
+    sub compare
+    {
+	my ($key, $key2) = @_ ;
+        ...
+        # return  0 if $key1 eq $key2
+        #        -1 if $key1 lt $key2
+        #         1 if $key1 gt $key2
+        return (-1 , 0 or 1) ;
+    }
+
+    sub prefix
+    {
+	my ($key, $key2) = @_ ;
+        ...
+        # return number of bytes of $key2 which are 
+        # necessary to determine that it is greater than $key1
+        return $bytes ;
+    }
+
+See L<Changing the BTREE sort order> for an example of using the
+C<compare> template.
+
+If you are using the DB_RECNO interface and you intend making use of
+C<bval>, you should check out L<The 'bval' Option>.
+
+=head2 Default Parameters
+
+It is possible to omit some or all of the final 4 parameters in the
+call to C<tie> and let them take default values. As DB_HASH is the most
+common file format used, the call:
+
+    tie %A, "DB_File", "filename" ;
+
+is equivalent to:
+
+    tie %A, "DB_File", "filename", O_CREAT|O_RDWR, 0666, $DB_HASH ;
+
+It is also possible to omit the filename parameter as well, so the
+call:
+
+    tie %A, "DB_File" ;
+
+is equivalent to:
+
+    tie %A, "DB_File", undef, O_CREAT|O_RDWR, 0666, $DB_HASH ;
+
+See L<In Memory Databases> for a discussion on the use of C<undef>
+in place of a filename.
+
+=head2 In Memory Databases
+
+Berkeley DB allows the creation of in-memory databases by using NULL
+(that is, a C<(char *)0> in C) in place of the filename.  B<DB_File>
+uses C<undef> instead of NULL to provide this functionality.
+
+=head1 DB_HASH
+
+The DB_HASH file format is probably the most commonly used of the three
+file formats that B<DB_File> supports. It is also very straightforward
+to use.
+
+=head2 A Simple Example
+
+This example shows how to create a database, add key/value pairs to the
+database, delete keys/value pairs and finally how to enumerate the
+contents of the database.
+
+    use strict ;
+    use DB_File ;
+    use vars qw( %h $k $v ) ;
+
+    tie %h, "DB_File", "fruit", O_RDWR|O_CREAT, 0640, $DB_HASH 
+        or die "Cannot open file 'fruit': $!\n";
+
+    # Add a few key/value pairs to the file
+    $h{"apple"} = "red" ;
+    $h{"orange"} = "orange" ;
+    $h{"banana"} = "yellow" ;
+    $h{"tomato"} = "red" ;
+
+    # Check for existence of a key
+    print "Banana Exists\n\n" if $h{"banana"} ;
+
+    # Delete a key/value pair.
+    delete $h{"apple"} ;
+
+    # print the contents of the file
+    while (($k, $v) = each %h)
+      { print "$k -> $v\n" }
+
+    untie %h ;
+
+here is the output:
+
+    Banana Exists
+ 
+    orange -> orange
+    tomato -> red
+    banana -> yellow
+
+Note that the like ordinary associative arrays, the order of the keys
+retrieved is in an apparently random order.
+
+=head1 DB_BTREE
+
+The DB_BTREE format is useful when you want to store data in a given
+order. By default the keys will be stored in lexical order, but as you
+will see from the example shown in the next section, it is very easy to
+define your own sorting function.
+
+=head2 Changing the BTREE sort order
+
+This script shows how to override the default sorting algorithm that
+BTREE uses. Instead of using the normal lexical ordering, a case
+insensitive compare function will be used.
+
+    use strict ;
+    use DB_File ;
+
+    my %h ;
+
+    sub Compare
+    {
+        my ($key1, $key2) = @_ ;
+        "\L$key1" cmp "\L$key2" ;
+    }
+
+    # specify the Perl sub that will do the comparison
+    $DB_BTREE->{'compare'} = \&Compare ;
+
+    tie %h, "DB_File", "tree", O_RDWR|O_CREAT, 0640, $DB_BTREE 
+        or die "Cannot open file 'tree': $!\n" ;
+
+    # Add a key/value pair to the file
+    $h{'Wall'} = 'Larry' ;
+    $h{'Smith'} = 'John' ;
+    $h{'mouse'} = 'mickey' ;
+    $h{'duck'}  = 'donald' ;
+
+    # Delete
+    delete $h{"duck"} ;
+
+    # Cycle through the keys printing them in order.
+    # Note it is not necessary to sort the keys as
+    # the btree will have kept them in order automatically.
+    foreach (keys %h)
+      { print "$_\n" }
+
+    untie %h ;
+
+Here is the output from the code above.
+
+    mouse
+    Smith
+    Wall
+
+There are a few point to bear in mind if you want to change the
+ordering in a BTREE database:
+
+=over 5
+
+=item 1.
+
+The new compare function must be specified when you create the database.
+
+=item 2.
+
+You cannot change the ordering once the database has been created. Thus
+you must use the same compare function every time you access the
+database.
+
+=back 
+
+=head2 Handling Duplicate Keys 
+
+The BTREE file type optionally allows a single key to be associated
+with an arbitrary number of values. This option is enabled by setting
+the flags element of C<$DB_BTREE> to R_DUP when creating the database.
+
+There are some difficulties in using the tied hash interface if you
+want to manipulate a BTREE database with duplicate keys. Consider this
+code:
+
+    use strict ;
+    use DB_File ;
+
+    use vars qw($filename %h ) ;
+
+    $filename = "tree" ;
+    unlink $filename ;
+ 
+    # Enable duplicate records
+    $DB_BTREE->{'flags'} = R_DUP ;
+ 
+    tie %h, "DB_File", $filename, O_RDWR|O_CREAT, 0640, $DB_BTREE 
+	or die "Cannot open $filename: $!\n";
+ 
+    # Add some key/value pairs to the file
+    $h{'Wall'} = 'Larry' ;
+    $h{'Wall'} = 'Brick' ; # Note the duplicate key
+    $h{'Wall'} = 'Brick' ; # Note the duplicate key and value
+    $h{'Smith'} = 'John' ;
+    $h{'mouse'} = 'mickey' ;
+
+    # iterate through the associative array
+    # and print each key/value pair.
+    foreach (keys %h)
+      { print "$_  -> $h{$_}\n" }
+
+    untie %h ;
+
+Here is the output:
+
+    Smith   -> John
+    Wall    -> Larry
+    Wall    -> Larry
+    Wall    -> Larry
+    mouse   -> mickey
+
+As you can see 3 records have been successfully created with key C<Wall>
+- the only thing is, when they are retrieved from the database they
+I<seem> to have the same value, namely C<Larry>. The problem is caused
+by the way that the associative array interface works. Basically, when
+the associative array interface is used to fetch the value associated
+with a given key, it will only ever retrieve the first value.
+
+Although it may not be immediately obvious from the code above, the
+associative array interface can be used to write values with duplicate
+keys, but it cannot be used to read them back from the database.
+
+The way to get around this problem is to use the Berkeley DB API method
+called C<seq>.  This method allows sequential access to key/value
+pairs. See L<THE API INTERFACE> for details of both the C<seq> method
+and the API in general.
+
+Here is the script above rewritten using the C<seq> API method.
+
+    use strict ;
+    use DB_File ;
+ 
+    use vars qw($filename $x %h $status $key $value) ;
+
+    $filename = "tree" ;
+    unlink $filename ;
+ 
+    # Enable duplicate records
+    $DB_BTREE->{'flags'} = R_DUP ;
+ 
+    $x = tie %h, "DB_File", $filename, O_RDWR|O_CREAT, 0640, $DB_BTREE 
+	or die "Cannot open $filename: $!\n";
+ 
+    # Add some key/value pairs to the file
+    $h{'Wall'} = 'Larry' ;
+    $h{'Wall'} = 'Brick' ; # Note the duplicate key
+    $h{'Wall'} = 'Brick' ; # Note the duplicate key and value
+    $h{'Smith'} = 'John' ;
+    $h{'mouse'} = 'mickey' ;
+ 
+    # iterate through the btree using seq
+    # and print each key/value pair.
+    $key = $value = 0 ;
+    for ($status = $x->seq($key, $value, R_FIRST) ;
+         $status == 0 ;
+         $status = $x->seq($key, $value, R_NEXT) )
+      {  print "$key -> $value\n" }
+ 
+    undef $x ;
+    untie %h ;
+
+that prints:
+
+    Smith   -> John
+    Wall    -> Brick
+    Wall    -> Brick
+    Wall    -> Larry
+    mouse   -> mickey
+
+This time we have got all the key/value pairs, including the multiple
+values associated with the key C<Wall>.
+
+=head2 The get_dup() Method
+
+B<DB_File> comes with a utility method, called C<get_dup>, to assist in
+reading duplicate values from BTREE databases. The method can take the
+following forms:
+
+    $count = $x->get_dup($key) ;
+    @list  = $x->get_dup($key) ;
+    %list  = $x->get_dup($key, 1) ;
+
+In a scalar context the method returns the number of values associated
+with the key, C<$key>.
+
+In list context, it returns all the values which match C<$key>. Note
+that the values will be returned in an apparently random order.
+
+In list context, if the second parameter is present and evaluates
+TRUE, the method returns an associative array. The keys of the
+associative array correspond to the values that matched in the BTREE
+and the values of the array are a count of the number of times that
+particular value occurred in the BTREE.
+
+So assuming the database created above, we can use C<get_dup> like
+this:
+
+    my $cnt  = $x->get_dup("Wall") ;
+    print "Wall occurred $cnt times\n" ;
+
+    my %hash = $x->get_dup("Wall", 1) ;
+    print "Larry is there\n" if $hash{'Larry'} ;
+    print "There are $hash{'Brick'} Brick Walls\n" ;
+
+    my @list = $x->get_dup("Wall") ;
+    print "Wall =>	[@list]\n" ;
+
+    @list = $x->get_dup("Smith") ;
+    print "Smith =>	[@list]\n" ;
+ 
+    @list = $x->get_dup("Dog") ;
+    print "Dog =>	[@list]\n" ;
+
+
+and it will print:
+
+    Wall occurred 3 times
+    Larry is there
+    There are 2 Brick Walls
+    Wall =>	[Brick Brick Larry]
+    Smith =>	[John]
+    Dog =>	[]
+
+=head2 Matching Partial Keys 
+
+The BTREE interface has a feature which allows partial keys to be
+matched. This functionality is I<only> available when the C<seq> method
+is used along with the R_CURSOR flag.
+
+    $x->seq($key, $value, R_CURSOR) ;
+
+Here is the relevant quote from the dbopen man page where it defines
+the use of the R_CURSOR flag with seq:
+
+    Note, for the DB_BTREE access method, the returned key is not
+    necessarily an exact match for the specified key. The returned key
+    is the smallest key greater than or equal to the specified key,
+    permitting partial key matches and range searches.
+
+In the example script below, the C<match> sub uses this feature to find
+and print the first matching key/value pair given a partial key.
+
+    use strict ;
+    use DB_File ;
+    use Fcntl ;
+
+    use vars qw($filename $x %h $st $key $value) ;
+
+    sub match
+    {
+        my $key = shift ;
+        my $value = 0;
+        my $orig_key = $key ;
+        $x->seq($key, $value, R_CURSOR) ;
+        print "$orig_key\t-> $key\t-> $value\n" ;
+    }
+
+    $filename = "tree" ;
+    unlink $filename ;
+
+    $x = tie %h, "DB_File", $filename, O_RDWR|O_CREAT, 0640, $DB_BTREE
+        or die "Cannot open $filename: $!\n";
+ 
+    # Add some key/value pairs to the file
+    $h{'mouse'} = 'mickey' ;
+    $h{'Wall'} = 'Larry' ;
+    $h{'Walls'} = 'Brick' ; 
+    $h{'Smith'} = 'John' ;
+ 
+
+    $key = $value = 0 ;
+    print "IN ORDER\n" ;
+    for ($st = $x->seq($key, $value, R_FIRST) ;
+	 $st == 0 ;
+         $st = $x->seq($key, $value, R_NEXT) )
+	
+      {  print "$key -> $value\n" }
+ 
+    print "\nPARTIAL MATCH\n" ;
+
+    match "Wa" ;
+    match "A" ;
+    match "a" ;
+
+    undef $x ;
+    untie %h ;
+
+Here is the output:
+
+    IN ORDER
+    Smith -> John
+    Wall  -> Larry
+    Walls -> Brick
+    mouse -> mickey
+
+    PARTIAL MATCH
+    Wa -> Wall  -> Larry
+    A  -> Smith -> John
+    a  -> mouse -> mickey
+
+=head1 DB_RECNO
+
+DB_RECNO provides an interface to flat text files. Both variable and
+fixed length records are supported.
+
+In order to make RECNO more compatible with Perl the array offset for
+all RECNO arrays begins at 0 rather than 1 as in Berkeley DB.
+
+As with normal Perl arrays, a RECNO array can be accessed using
+negative indexes. The index -1 refers to the last element of the array,
+-2 the second last, and so on. Attempting to access an element before
+the start of the array will raise a fatal run-time error.
+
+=head2 The 'bval' Option
+
+The operation of the bval option warrants some discussion. Here is the
+definition of bval from the Berkeley DB 1.85 recno manual page:
+
+    The delimiting byte to be used to mark  the  end  of  a
+    record for variable-length records, and the pad charac-
+    ter for fixed-length records.  If no  value  is  speci-
+    fied,  newlines  (``\n'')  are  used to mark the end of
+    variable-length records and  fixed-length  records  are
+    padded with spaces.
+
+The second sentence is wrong. In actual fact bval will only default to
+C<"\n"> when the openinfo parameter in dbopen is NULL. If a non-NULL
+openinfo parameter is used at all, the value that happens to be in bval
+will be used. That means you always have to specify bval when making
+use of any of the options in the openinfo parameter. This documentation
+error will be fixed in the next release of Berkeley DB.
+
+That clarifies the situation with regards Berkeley DB itself. What
+about B<DB_File>? Well, the behavior defined in the quote above is
+quite useful, so B<DB_File> conforms it.
+
+That means that you can specify other options (e.g. cachesize) and
+still have bval default to C<"\n"> for variable length records, and
+space for fixed length records.
+
+=head2 A Simple Example
+
+Here is a simple example that uses RECNO.
+
+    use strict ;
+    use DB_File ;
+
+    my @h ;
+    tie @h, "DB_File", "text", O_RDWR|O_CREAT, 0640, $DB_RECNO 
+        or die "Cannot open file 'text': $!\n" ;
+
+    # Add a few key/value pairs to the file
+    $h[0] = "orange" ;
+    $h[1] = "blue" ;
+    $h[2] = "yellow" ;
+
+    # Check for existence of a key
+    print "Element 1 Exists with value $h[1]\n" if $h[1] ;
+
+    # use a negative index
+    print "The last element is $h[-1]\n" ;
+    print "The 2nd last element is $h[-2]\n" ;
+
+    untie @h ;
+
+Here is the output from the script:
+
+
+    Element 1 Exists with value blue
+    The last element is yellow
+    The 2nd last element is blue
+
+=head2 Extra Methods
+
+If you are using a version of Perl earlier than 5.004_57, the tied
+array interface is quite limited. The example script above will work,
+but you won't be able to use C<push>, C<pop>, C<shift>, C<unshift>
+etc. with the tied array.
+
+To make the interface more useful for older versions of Perl, a number
+of methods are supplied with B<DB_File> to simulate the missing array
+operations. All these methods are accessed via the object returned from
+the tie call.
+
+Here are the methods:
+
+=over 5
+
+=item B<$X-E<gt>push(list) ;>
+
+Pushes the elements of C<list> to the end of the array.
+
+=item B<$value = $X-E<gt>pop ;>
+
+Removes and returns the last element of the array.
+
+=item B<$X-E<gt>shift>
+
+Removes and returns the first element of the array.
+
+=item B<$X-E<gt>unshift(list) ;>
+
+Pushes the elements of C<list> to the start of the array.
+
+=item B<$X-E<gt>length>
+
+Returns the number of elements in the array.
+
+=back
+
+=head2 Another Example
+
+Here is a more complete example that makes use of some of the methods
+described above. It also makes use of the API interface directly (see 
+L<THE API INTERFACE>).
+
+    use strict ;
+    use vars qw(@h $H $file $i) ;
+    use DB_File ;
+    use Fcntl ;
+    
+    $file = "text" ;
+
+    unlink $file ;
+
+    $H = tie @h, "DB_File", $file, O_RDWR|O_CREAT, 0640, $DB_RECNO 
+        or die "Cannot open file $file: $!\n" ;
+    
+    # first create a text file to play with
+    $h[0] = "zero" ;
+    $h[1] = "one" ;
+    $h[2] = "two" ;
+    $h[3] = "three" ;
+    $h[4] = "four" ;
+
+    
+    # Print the records in order.
+    #
+    # The length method is needed here because evaluating a tied
+    # array in a scalar context does not return the number of
+    # elements in the array.  
+
+    print "\nORIGINAL\n" ;
+    foreach $i (0 .. $H->length - 1) {
+        print "$i: $h[$i]\n" ;
+    }
+
+    # use the push & pop methods
+    $a = $H->pop ;
+    $H->push("last") ;
+    print "\nThe last record was [$a]\n" ;
+
+    # and the shift & unshift methods
+    $a = $H->shift ;
+    $H->unshift("first") ;
+    print "The first record was [$a]\n" ;
+
+    # Use the API to add a new record after record 2.
+    $i = 2 ;
+    $H->put($i, "Newbie", R_IAFTER) ;
+
+    # and a new record before record 1.
+    $i = 1 ;
+    $H->put($i, "New One", R_IBEFORE) ;
+
+    # delete record 3
+    $H->del(3) ;
+
+    # now print the records in reverse order
+    print "\nREVERSE\n" ;
+    for ($i = $H->length - 1 ; $i >= 0 ; -- $i)
+      { print "$i: $h[$i]\n" }
+
+    # same again, but use the API functions instead
+    print "\nREVERSE again\n" ;
+    my ($s, $k, $v)  = (0, 0, 0) ;
+    for ($s = $H->seq($k, $v, R_LAST) ; 
+             $s == 0 ; 
+             $s = $H->seq($k, $v, R_PREV))
+      { print "$k: $v\n" }
+
+    undef $H ;
+    untie @h ;
+
+and this is what it outputs:
+
+    ORIGINAL
+    0: zero
+    1: one
+    2: two
+    3: three
+    4: four
+
+    The last record was [four]
+    The first record was [zero]
+
+    REVERSE
+    5: last
+    4: three
+    3: Newbie
+    2: one
+    1: New One
+    0: first
+
+    REVERSE again
+    5: last
+    4: three
+    3: Newbie
+    2: one
+    1: New One
+    0: first
+
+Notes:
+
+=over 5
+
+=item 1.
+
+Rather than iterating through the array, C<@h> like this:
+
+    foreach $i (@h)
+
+it is necessary to use either this:
+
+    foreach $i (0 .. $H->length - 1) 
+
+or this:
+
+    for ($a = $H->get($k, $v, R_FIRST) ;
+         $a == 0 ;
+         $a = $H->get($k, $v, R_NEXT) )
+
+=item 2.
+
+Notice that both times the C<put> method was used the record index was
+specified using a variable, C<$i>, rather than the literal value
+itself. This is because C<put> will return the record number of the
+inserted line via that parameter.
+
+=back
+
+=head1 THE API INTERFACE
+
+As well as accessing Berkeley DB using a tied hash or array, it is also
+possible to make direct use of most of the API functions defined in the
+Berkeley DB documentation.
+
+To do this you need to store a copy of the object returned from the tie.
+
+	$db = tie %hash, "DB_File", "filename" ;
+
+Once you have done that, you can access the Berkeley DB API functions
+as B<DB_File> methods directly like this:
+
+	$db->put($key, $value, R_NOOVERWRITE) ;
+
+B<Important:> If you have saved a copy of the object returned from
+C<tie>, the underlying database file will I<not> be closed until both
+the tied variable is untied and all copies of the saved object are
+destroyed. 
+
+    use DB_File ;
+    $db = tie %hash, "DB_File", "filename" 
+        or die "Cannot tie filename: $!" ;
+    ...
+    undef $db ;
+    untie %hash ;
+
+See L<The untie() Gotcha> for more details.
+
+All the functions defined in L<dbopen> are available except for
+close() and dbopen() itself. The B<DB_File> method interface to the
+supported functions have been implemented to mirror the way Berkeley DB
+works whenever possible. In particular note that:
+
+=over 5
+
+=item *
+
+The methods return a status value. All return 0 on success.
+All return -1 to signify an error and set C<$!> to the exact
+error code. The return code 1 generally (but not always) means that the
+key specified did not exist in the database.
+
+Other return codes are defined. See below and in the Berkeley DB
+documentation for details. The Berkeley DB documentation should be used
+as the definitive source.
+
+=item *
+
+Whenever a Berkeley DB function returns data via one of its parameters,
+the equivalent B<DB_File> method does exactly the same.
+
+=item *
+
+If you are careful, it is possible to mix API calls with the tied
+hash/array interface in the same piece of code. Although only a few of
+the methods used to implement the tied interface currently make use of
+the cursor, you should always assume that the cursor has been changed
+any time the tied hash/array interface is used. As an example, this
+code will probably not do what you expect:
+
+    $X = tie %x, 'DB_File', $filename, O_RDWR|O_CREAT, 0777, $DB_BTREE
+        or die "Cannot tie $filename: $!" ;
+
+    # Get the first key/value pair and set  the cursor
+    $X->seq($key, $value, R_FIRST) ;
+
+    # this line will modify the cursor
+    $count = scalar keys %x ; 
+
+    # Get the second key/value pair.
+    # oops, it didn't, it got the last key/value pair!
+    $X->seq($key, $value, R_NEXT) ;
+
+The code above can be rearranged to get around the problem, like this:
+
+    $X = tie %x, 'DB_File', $filename, O_RDWR|O_CREAT, 0777, $DB_BTREE
+        or die "Cannot tie $filename: $!" ;
+
+    # this line will modify the cursor
+    $count = scalar keys %x ; 
+
+    # Get the first key/value pair and set  the cursor
+    $X->seq($key, $value, R_FIRST) ;
+
+    # Get the second key/value pair.
+    # worked this time.
+    $X->seq($key, $value, R_NEXT) ;
+
+=back
+
+All the constants defined in L<dbopen> for use in the flags parameters
+in the methods defined below are also available. Refer to the Berkeley
+DB documentation for the precise meaning of the flags values.
+
+Below is a list of the methods available.
+
+=over 5
+
+=item B<$status = $X-E<gt>get($key, $value [, $flags]) ;>
+
+Given a key (C<$key>) this method reads the value associated with it
+from the database. The value read from the database is returned in the
+C<$value> parameter.
+
+If the key does not exist the method returns 1.
+
+No flags are currently defined for this method.
+
+=item B<$status = $X-E<gt>put($key, $value [, $flags]) ;>
+
+Stores the key/value pair in the database.
+
+If you use either the R_IAFTER or R_IBEFORE flags, the C<$key> parameter
+will have the record number of the inserted key/value pair set.
+
+Valid flags are R_CURSOR, R_IAFTER, R_IBEFORE, R_NOOVERWRITE and
+R_SETCURSOR.
+
+=item B<$status = $X-E<gt>del($key [, $flags]) ;>
+
+Removes all key/value pairs with key C<$key> from the database.
+
+A return code of 1 means that the requested key was not in the
+database.
+
+R_CURSOR is the only valid flag at present.
+
+=item B<$status = $X-E<gt>fd ;>
+
+Returns the file descriptor for the underlying database.
+
+See L<Locking Databases> for an example of how to make use of the
+C<fd> method to lock your database.
+
+=item B<$status = $X-E<gt>seq($key, $value, $flags) ;>
+
+This interface allows sequential retrieval from the database. See
+L<dbopen> for full details.
+
+Both the C<$key> and C<$value> parameters will be set to the key/value
+pair read from the database.
+
+The flags parameter is mandatory. The valid flag values are R_CURSOR,
+R_FIRST, R_LAST, R_NEXT and R_PREV.
+
+=item B<$status = $X-E<gt>sync([$flags]) ;>
+
+Flushes any cached buffers to disk.
+
+R_RECNOSYNC is the only valid flag at present.
+
+=back
+
+=head1 HINTS AND TIPS 
+
+
+=head2 Locking Databases
+
+Concurrent access of a read-write database by several parties requires
+them all to use some kind of locking.  Here's an example of Tom's that
+uses the I<fd> method to get the file descriptor, and then a careful
+open() to give something Perl will flock() for you.  Run this repeatedly
+in the background to watch the locks granted in proper order.
+
+    use DB_File;
+
+    use strict;
+
+    sub LOCK_SH { 1 }
+    sub LOCK_EX { 2 }
+    sub LOCK_NB { 4 }
+    sub LOCK_UN { 8 }
+
+    my($oldval, $fd, $db, %db, $value, $key);
+
+    $key = shift || 'default';
+    $value = shift || 'magic';
+
+    $value .= " $$";
+
+    $db = tie(%db, 'DB_File', '/tmp/foo.db', O_CREAT|O_RDWR, 0644) 
+	    || die "dbcreat /tmp/foo.db $!";
+    $fd = $db->fd;
+    print "$$: db fd is $fd\n";
+    open(DB_FH, "+<&=$fd") || die "dup $!";
+
+
+    unless (flock (DB_FH, LOCK_SH | LOCK_NB)) {
+	print "$$: CONTENTION; can't read during write update!
+		    Waiting for read lock ($!) ....";
+	unless (flock (DB_FH, LOCK_SH)) { die "flock: $!" }
+    } 
+    print "$$: Read lock granted\n";
+
+    $oldval = $db{$key};
+    print "$$: Old value was $oldval\n";
+    flock(DB_FH, LOCK_UN);
+
+    unless (flock (DB_FH, LOCK_EX | LOCK_NB)) {
+	print "$$: CONTENTION; must have exclusive lock!
+		    Waiting for write lock ($!) ....";
+	unless (flock (DB_FH, LOCK_EX)) { die "flock: $!" }
+    } 
+
+    print "$$: Write lock granted\n";
+    $db{$key} = $value;
+    $db->sync;	# to flush
+    sleep 10;
+
+    flock(DB_FH, LOCK_UN);
+    undef $db;
+    untie %db;
+    close(DB_FH);
+    print "$$: Updated db to $key=$value\n";
+
+=head2 Sharing Databases With C Applications
+
+There is no technical reason why a Berkeley DB database cannot be
+shared by both a Perl and a C application.
+
+The vast majority of problems that are reported in this area boil down
+to the fact that C strings are NULL terminated, whilst Perl strings are
+not. 
+
+Here is a real example. Netscape 2.0 keeps a record of the locations you
+visit along with the time you last visited them in a DB_HASH database.
+This is usually stored in the file F<~/.netscape/history.db>. The key
+field in the database is the location string and the value field is the
+time the location was last visited stored as a 4 byte binary value.
+
+If you haven't already guessed, the location string is stored with a
+terminating NULL. This means you need to be careful when accessing the
+database.
+
+Here is a snippet of code that is loosely based on Tom Christiansen's
+I<ggh> script (available from your nearest CPAN archive in
+F<authors/id/TOMC/scripts/nshist.gz>).
+
+    use strict ;
+    use DB_File ;
+    use Fcntl ;
+
+    use vars qw( $dotdir $HISTORY %hist_db $href $binary_time $date ) ;
+    $dotdir = $ENV{HOME} || $ENV{LOGNAME};
+
+    $HISTORY = "$dotdir/.netscape/history.db";
+
+    tie %hist_db, 'DB_File', $HISTORY
+        or die "Cannot open $HISTORY: $!\n" ;;
+
+    # Dump the complete database
+    while ( ($href, $binary_time) = each %hist_db ) {
+
+        # remove the terminating NULL
+        $href =~ s/\x00$// ;
+
+        # convert the binary time into a user friendly string
+        $date = localtime unpack("V", $binary_time);
+        print "$date $href\n" ;
+    }
+
+    # check for the existence of a specific key
+    # remember to add the NULL
+    if ( $binary_time = $hist_db{"http://mox.perl.com/\x00"} ) {
+        $date = localtime unpack("V", $binary_time) ;
+        print "Last visited mox.perl.com on $date\n" ;
+    }
+    else {
+        print "Never visited mox.perl.com\n"
+    }
+
+    untie %hist_db ;
+
+=head2 The untie() Gotcha
+
+If you make use of the Berkeley DB API, it is I<very> strongly
+recommended that you read L<perltie/The untie Gotcha>. 
+
+Even if you don't currently make use of the API interface, it is still
+worth reading it.
+
+Here is an example which illustrates the problem from a B<DB_File>
+perspective:
+
+    use DB_File ;
+    use Fcntl ;
+
+    my %x ;
+    my $X ;
+
+    $X = tie %x, 'DB_File', 'tst.fil' , O_RDWR|O_TRUNC
+        or die "Cannot tie first time: $!" ;
+
+    $x{123} = 456 ;
+
+    untie %x ;
+
+    tie %x, 'DB_File', 'tst.fil' , O_RDWR|O_CREAT
+        or die "Cannot tie second time: $!" ;
+
+    untie %x ;
+
+When run, the script will produce this error message:
+
+    Cannot tie second time: Invalid argument at bad.file line 14.
+
+Although the error message above refers to the second tie() statement
+in the script, the source of the problem is really with the untie()
+statement that precedes it.
+
+Having read L<perltie> you will probably have already guessed that the
+error is caused by the extra copy of the tied object stored in C<$X>.
+If you haven't, then the problem boils down to the fact that the
+B<DB_File> destructor, DESTROY, will not be called until I<all>
+references to the tied object are destroyed. Both the tied variable,
+C<%x>, and C<$X> above hold a reference to the object. The call to
+untie() will destroy the first, but C<$X> still holds a valid
+reference, so the destructor will not get called and the database file
+F<tst.fil> will remain open. The fact that Berkeley DB then reports the
+attempt to open a database that is alreday open via the catch-all
+"Invalid argument" doesn't help.
+
+If you run the script with the C<-w> flag the error message becomes:
+
+    untie attempted while 1 inner references still exist at bad.file line 12.
+    Cannot tie second time: Invalid argument at bad.file line 14.
+
+which pinpoints the real problem. Finally the script can now be
+modified to fix the original problem by destroying the API object
+before the untie:
+
+    ...
+    $x{123} = 456 ;
+
+    undef $X ;
+    untie %x ;
+
+    $X = tie %x, 'DB_File', 'tst.fil' , O_RDWR|O_CREAT
+    ...
+
+
+=head1 COMMON QUESTIONS
+
+=head2 Why is there Perl source in my database?
+
+If you look at the contents of a database file created by DB_File,
+there can sometimes be part of a Perl script included in it.
+
+This happens because Berkeley DB uses dynamic memory to allocate
+buffers which will subsequently be written to the database file. Being
+dynamic, the memory could have been used for anything before DB
+malloced it. As Berkeley DB doesn't clear the memory once it has been
+allocated, the unused portions will contain random junk. In the case
+where a Perl script gets written to the database, the random junk will
+correspond to an area of dynamic memory that happened to be used during
+the compilation of the script.
+
+Unless you don't like the possibility of there being part of your Perl
+scripts embedded in a database file, this is nothing to worry about.
+
+=head2 How do I store complex data structures with DB_File?
+
+Although B<DB_File> cannot do this directly, there is a module which
+can layer transparently over B<DB_File> to accomplish this feat.
+
+Check out the MLDBM module, available on CPAN in the directory
+F<modules/by-module/MLDBM>.
+
+=head2 What does "Invalid Argument" mean?
+
+You will get this error message when one of the parameters in the
+C<tie> call is wrong. Unfortunately there are quite a few parameters to
+get wrong, so it can be difficult to figure out which one it is.
+
+Here are a couple of possibilities:
+
+=over 5
+
+=item 1.
+
+Attempting to reopen a database without closing it. 
+
+=item 2.
+
+Using the O_WRONLY flag.
+
+=back
+
+=head2 What does "Bareword 'DB_File' not allowed" mean? 
+
+You will encounter this particular error message when you have the
+C<strict 'subs'> pragma (or the full strict pragma) in your script.
+Consider this script:
+
+    use strict ;
+    use DB_File ;
+    use vars qw(%x) ;
+    tie %x, DB_File, "filename" ;
+
+Running it produces the error in question:
+
+    Bareword "DB_File" not allowed while "strict subs" in use 
+
+To get around the error, place the word C<DB_File> in either single or
+double quotes, like this:
+
+    tie %x, "DB_File", "filename" ;
+
+Although it might seem like a real pain, it is really worth the effort
+of having a C<use strict> in all your scripts.
+
+=head1 HISTORY
+
+Moved to the Changes file.
+
+=head1 BUGS
+
+Some older versions of Berkeley DB had problems with fixed length
+records using the RECNO file format. This problem has been fixed since
+version 1.85 of Berkeley DB.
+
+I am sure there are bugs in the code. If you do find any, or can
+suggest any enhancements, I would welcome your comments.
+
+=head1 AVAILABILITY
+
+B<DB_File> comes with the standard Perl source distribution. Look in
+the directory F<ext/DB_File>. Given the amount of time between releases
+of Perl the version that ships with Perl is quite likely to be out of
+date, so the most recent version can always be found on CPAN (see
+L<perlmod/CPAN> for details), in the directory
+F<modules/by-module/DB_File>.
+
+This version of B<DB_File> will work with either version 1.x or 2.x of
+Berkeley DB, but is limited to the functionality provided by version 1.
+
+The official web site for Berkeley DB is
+F<http://www.sleepycat.com/db>. The ftp equivalent is
+F<ftp.sleepycat.com:/pub>. Both versions 1 and 2 of Berkeley DB are
+available there.
+
+Alternatively, Berkeley DB version 1 is available at your nearest CPAN
+archive in F<src/misc/db.1.85.tar.gz>.
+
+If you are running IRIX, then get Berkeley DB version 1 from
+F<http://reality.sgi.com/ariel>. It has the patches necessary to
+compile properly on IRIX 5.3.
+
+=head1 COPYRIGHT
+
+Copyright (c) 1995-8 Paul Marquess. All rights reserved. This program
+is free software; you can redistribute it and/or modify it under the
+same terms as Perl itself.
+
+Although B<DB_File> is covered by the Perl license, the library it
+makes use of, namely Berkeley DB, is not. Berkeley DB has its own
+copyright and its own license. Please take the time to read it.
+
+Here are are few words taken from the Berkeley DB FAQ (at
+http://www.sleepycat.com) regarding the license:
+
+    Do I have to license DB to use it in Perl scripts? 
+
+    No. The Berkeley DB license requires that software that uses
+    Berkeley DB be freely redistributable. In the case of Perl, that
+    software is Perl, and not your scripts. Any Perl scripts that you
+    write are your property, including scripts that make use of
+    Berkeley DB. Neither the Perl license nor the Berkeley DB license
+    place any restriction on what you may do with them.
+
+If you are in any doubt about the license situation, contact either the
+Berkeley DB authors or the author of DB_File. See L<"AUTHOR"> for details.
+
+
+=head1 SEE ALSO
+
+L<perl(1)>, L<dbopen(3)>, L<hash(3)>, L<recno(3)>, L<btree(3)> 
+
+=head1 AUTHOR
+
+The DB_File interface was written by Paul Marquess
+E<lt>pmarquess@bfsec.bt.co.ukE<gt>.
+Questions about the DB system itself may be addressed to
+E<lt>db@sleepycat.com<gt>.
+
+=cut
diff --git a/contrib/perl5/ext/DB_File/DB_File.xs b/contrib/perl5/ext/DB_File/DB_File.xs
new file mode 100644
index 0000000..c661023
--- /dev/null
+++ b/contrib/perl5/ext/DB_File/DB_File.xs
@@ -0,0 +1,1497 @@
+/* 
+
+ DB_File.xs -- Perl 5 interface to Berkeley DB 
+
+ written by Paul Marquess (pmarquess@bfsec.bt.co.uk)
+ last modified 16th May 1998
+ version 1.60
+
+ All comments/suggestions/problems are welcome
+
+     Copyright (c) 1995, 1996, 1997, 1998 Paul Marquess. All rights reserved.
+     This program is free software; you can redistribute it and/or
+     modify it under the same terms as Perl itself.
+
+ Changes:
+	0.1 - 	Initial Release
+	0.2 - 	No longer bombs out if dbopen returns an error.
+	0.3 - 	Added some support for multiple btree compares
+	1.0 - 	Complete support for multiple callbacks added.
+	      	Fixed a problem with pushing a value onto an empty list.
+	1.01 - 	Fixed a SunOS core dump problem.
+		The return value from TIEHASH wasn't set to NULL when
+		dbopen returned an error.
+	1.02 - 	Use ALIAS to define TIEARRAY.
+		Removed some redundant commented code.
+		Merged OS2 code into the main distribution.
+		Allow negative subscripts with RECNO interface.
+		Changed the default flags to O_CREAT|O_RDWR
+	1.03 - 	Added EXISTS
+	1.04 -  fixed a couple of bugs in hash_cb. Patches supplied by
+		Dave Hammen, hammen@gothamcity.jsc.nasa.gov
+	1.05 -  Added logic to allow prefix & hash types to be specified via
+		Makefile.PL
+	1.06 -  Minor namespace cleanup: Localized PrintBtree.
+	1.07 -  Fixed bug with RECNO, where bval wasn't defaulting to "\n". 
+	1.08 -  No change to DB_File.xs
+	1.09 -  Default mode for dbopen changed to 0666
+	1.10 -  Fixed fd method so that it still returns -1 for
+		in-memory files when db 1.86 is used.
+	1.11 -  No change to DB_File.xs
+	1.12 -  No change to DB_File.xs
+	1.13 -  Tidied up a few casts.     
+	1.14 -	Made it illegal to tie an associative array to a RECNO
+		database and an ordinary array to a HASH or BTREE database.
+	1.50 -  Make work with both DB 1.x or DB 2.x
+	1.51 -  Fixed a bug in mapping 1.x O_RDONLY flag to 2.x DB_RDONLY equivalent
+	1.52 -  Patch from Gisle Aas <gisle@aas.no> to suppress "use of 
+		undefined value" warning with db_get and db_seq.
+	1.53 -  Added DB_RENUMBER to flags for recno.
+	1.54 -  Fixed bug in the fd method
+        1.55 -  Fix for AIX from Jarkko Hietaniemi
+        1.56 -  No change to DB_File.xs
+        1.57 -  added the #undef op to allow building with Threads support.
+	1.58 -  Fixed a problem with the use of sv_setpvn. When the
+		size is specified as 0, it does a strlen on the data.
+		This was ok for DB 1.x, but isn't for DB 2.x.
+        1.59 -  No change to DB_File.xs
+        1.60 -  Some code tidy up
+
+
+
+*/
+
+#include "EXTERN.h"  
+#include "perl.h"
+#include "XSUB.h"
+
+/* Being the Berkeley DB we prefer the <sys/cdefs.h> (which will be
+ * shortly #included by the <db.h>) __attribute__ to the possibly
+ * already defined __attribute__, for example by GNUC or by Perl. */
+
+#undef __attribute__
+
+/* If Perl has been compiled with Threads support,the symbol op will
+   be defined here. This clashes with a field name in db.h, so get rid of it.
+ */
+#ifdef op
+#undef op
+#endif
+#include <db.h>
+
+#include <fcntl.h> 
+
+/* #define TRACE */
+
+
+
+#ifdef DB_VERSION_MAJOR
+
+/* map version 2 features & constants onto their version 1 equivalent */
+
+#ifdef DB_Prefix_t
+#undef DB_Prefix_t
+#endif
+#define DB_Prefix_t	size_t
+
+#ifdef DB_Hash_t
+#undef DB_Hash_t
+#endif
+#define DB_Hash_t	u_int32_t
+
+/* DBTYPE stays the same */
+/* HASHINFO, RECNOINFO and BTREEINFO  map to DB_INFO */
+typedef DB_INFO	INFO ;
+
+/* version 2 has db_recno_t in place of recno_t	*/
+typedef db_recno_t	recno_t;
+
+
+#define R_CURSOR        DB_SET_RANGE
+#define R_FIRST         DB_FIRST
+#define R_IAFTER        DB_AFTER
+#define R_IBEFORE       DB_BEFORE
+#define R_LAST          DB_LAST
+#define R_NEXT          DB_NEXT
+#define R_NOOVERWRITE   DB_NOOVERWRITE
+#define R_PREV          DB_PREV
+#define R_SETCURSOR     0
+#define R_RECNOSYNC     0
+#define R_FIXEDLEN	DB_FIXEDLEN
+#define R_DUP		DB_DUP
+
+#define db_HA_hash 	h_hash
+#define db_HA_ffactor	h_ffactor
+#define db_HA_nelem	h_nelem
+#define db_HA_bsize	db_pagesize
+#define db_HA_cachesize	db_cachesize
+#define db_HA_lorder	db_lorder
+
+#define db_BT_compare	bt_compare
+#define db_BT_prefix	bt_prefix
+#define db_BT_flags	flags
+#define db_BT_psize	db_pagesize
+#define db_BT_cachesize	db_cachesize
+#define db_BT_lorder	db_lorder
+#define db_BT_maxkeypage
+#define db_BT_minkeypage
+
+
+#define db_RE_reclen	re_len
+#define db_RE_flags	flags
+#define db_RE_bval	re_pad
+#define db_RE_bfname	re_source
+#define db_RE_psize	db_pagesize
+#define db_RE_cachesize	db_cachesize
+#define db_RE_lorder	db_lorder
+
+#define TXN	NULL,
+
+#define do_SEQ(db, key, value, flag)	(db->cursor->c_get)(db->cursor, &key, &value, flag)
+
+
+#define DBT_flags(x)	x.flags = 0
+#define DB_flags(x, v)	x |= v 
+
+#else /* db version 1.x */
+
+typedef union INFO {
+        HASHINFO 	hash ;
+        RECNOINFO 	recno ;
+        BTREEINFO 	btree ;
+      } INFO ;
+
+
+#ifdef mDB_Prefix_t 
+#ifdef DB_Prefix_t
+#undef DB_Prefix_t
+#endif
+#define DB_Prefix_t	mDB_Prefix_t 
+#endif
+
+#ifdef mDB_Hash_t
+#ifdef DB_Hash_t
+#undef DB_Hash_t
+#endif
+#define DB_Hash_t	mDB_Hash_t
+#endif
+
+#define db_HA_hash 	hash.hash
+#define db_HA_ffactor	hash.ffactor
+#define db_HA_nelem	hash.nelem
+#define db_HA_bsize	hash.bsize
+#define db_HA_cachesize	hash.cachesize
+#define db_HA_lorder	hash.lorder
+
+#define db_BT_compare	btree.compare
+#define db_BT_prefix	btree.prefix
+#define db_BT_flags	btree.flags
+#define db_BT_psize	btree.psize
+#define db_BT_cachesize	btree.cachesize
+#define db_BT_lorder	btree.lorder
+#define db_BT_maxkeypage btree.maxkeypage
+#define db_BT_minkeypage btree.minkeypage
+
+#define db_RE_reclen	recno.reclen
+#define db_RE_flags	recno.flags
+#define db_RE_bval	recno.bval
+#define db_RE_bfname	recno.bfname
+#define db_RE_psize	recno.psize
+#define db_RE_cachesize	recno.cachesize
+#define db_RE_lorder	recno.lorder
+
+#define TXN	
+
+#define do_SEQ(db, key, value, flag)	(db->dbp->seq)(db->dbp, &key, &value, flag)
+#define DBT_flags(x)	
+#define DB_flags(x, v)	
+
+#endif /* db version 1 */
+
+
+
+#define db_DELETE(db, key, flags)       ((db->dbp)->del)(db->dbp, TXN &key, flags)
+#define db_STORE(db, key, value, flags) ((db->dbp)->put)(db->dbp, TXN &key, &value, flags)
+#define db_FETCH(db, key, flags)        ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
+
+#define db_sync(db, flags)              ((db->dbp)->sync)(db->dbp, flags)
+#define db_get(db, key, value, flags)   ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
+#ifdef DB_VERSION_MAJOR
+#define db_DESTROY(db)                  ((db->dbp)->close)(db->dbp, 0)
+#define db_close(db)			((db->dbp)->close)(db->dbp, 0)
+#define db_del(db, key, flags)          ((flags & R_CURSOR) 					\
+						? ((db->cursor)->c_del)(db->cursor, 0)		\
+						: ((db->dbp)->del)(db->dbp, NULL, &key, flags) )
+
+#else
+
+#define db_DESTROY(db)                  ((db->dbp)->close)(db->dbp)
+#define db_close(db)			((db->dbp)->close)(db->dbp)
+#define db_del(db, key, flags)          ((db->dbp)->del)(db->dbp, &key, flags)
+#define db_put(db, key, value, flags)   ((db->dbp)->put)(db->dbp, &key, &value, flags)
+
+#endif
+
+#define db_seq(db, key, value, flags)   do_SEQ(db, key, value, flags)
+
+typedef struct {
+	DBTYPE	type ;
+	DB * 	dbp ;
+	SV *	compare ;
+	SV *	prefix ;
+	SV *	hash ;
+	int	in_memory ;
+	INFO 	info ;
+#ifdef DB_VERSION_MAJOR
+	DBC *	cursor ;
+#endif
+	} DB_File_type;
+
+typedef DB_File_type * DB_File ;
+typedef DBT DBTKEY ;
+
+#define my_sv_setpvn(sv, d, s) sv_setpvn(sv, (s ? d : (void*)""), s)
+
+#define OutputValue(arg, name)  				\
+	{ if (RETVAL == 0) {					\
+	      my_sv_setpvn(arg, name.data, name.size) ;		\
+	  }							\
+	}
+
+#define OutputKey(arg, name)	 				\
+	{ if (RETVAL == 0) 					\
+	  { 							\
+		if (db->type != DB_RECNO) {			\
+		    my_sv_setpvn(arg, name.data, name.size); 	\
+		}						\
+		else 						\
+		    sv_setiv(arg, (I32)*(I32*)name.data - 1); 	\
+	  } 							\
+	}
+
+
+/* Internal Global Data */
+static recno_t Value ; 
+static recno_t zero = 0 ;
+static DB_File CurrentDB ;
+static DBTKEY empty ;
+
+#ifdef DB_VERSION_MAJOR
+
+static int
+db_put(db, key, value, flags)
+DB_File		db ;
+DBTKEY		key ;
+DBT		value ;
+u_int		flags ;
+
+{
+    int status ;
+
+    if (flags & R_CURSOR) {
+	status = ((db->cursor)->c_del)(db->cursor, 0);
+	if (status != 0)
+	    return status ;
+
+	flags &= ~R_CURSOR ;
+    }
+
+    return ((db->dbp)->put)(db->dbp, NULL, &key, &value, flags) ;
+
+}
+
+#endif /* DB_VERSION_MAJOR */
+
+static void
+GetVersionInfo()
+{
+    SV * ver_sv = perl_get_sv("DB_File::db_version", TRUE) ;
+#ifdef DB_VERSION_MAJOR
+    int Major, Minor, Patch ;
+
+    (void)db_version(&Major, &Minor, &Patch) ;
+
+    /* check that libdb is recent enough */
+    if (Major == 2 && Minor ==  0 && Patch < 5)
+	croak("DB_File needs Berkeley DB 2.0.5 or greater, you have %d.%d.%d\n",
+		 Major, Minor, Patch) ;
+ 
+#if PATCHLEVEL > 3
+    sv_setpvf(ver_sv, "%d.%d", Major, Minor) ;
+#else
+    {
+        char buffer[40] ;
+        sprintf(buffer, "%d.%d", Major, Minor) ;
+        sv_setpv(ver_sv, buffer) ; 
+    }
+#endif
+ 
+#else
+    sv_setiv(ver_sv, 1) ;
+#endif
+
+}
+
+
+static int
+btree_compare(key1, key2)
+const DBT * key1 ;
+const DBT * key2 ;
+{
+    dSP ;
+    void * data1, * data2 ;
+    int retval ;
+    int count ;
+    
+    data1 = key1->data ;
+    data2 = key2->data ;
+
+    /* As newSVpv will assume that the data pointer is a null terminated C 
+       string if the size parameter is 0, make sure that data points to an 
+       empty string if the length is 0
+    */
+    if (key1->size == 0)
+        data1 = "" ; 
+    if (key2->size == 0)
+        data2 = "" ;
+
+    ENTER ;
+    SAVETMPS;
+
+    PUSHMARK(SP) ;
+    EXTEND(SP,2) ;
+    PUSHs(sv_2mortal(newSVpv(data1,key1->size)));
+    PUSHs(sv_2mortal(newSVpv(data2,key2->size)));
+    PUTBACK ;
+
+    count = perl_call_sv(CurrentDB->compare, G_SCALAR); 
+
+    SPAGAIN ;
+
+    if (count != 1)
+        croak ("DB_File btree_compare: expected 1 return value from compare sub, got %d\n", count) ;
+
+    retval = POPi ;
+
+    PUTBACK ;
+    FREETMPS ;
+    LEAVE ;
+    return (retval) ;
+
+}
+
+static DB_Prefix_t
+btree_prefix(key1, key2)
+const DBT * key1 ;
+const DBT * key2 ;
+{
+    dSP ;
+    void * data1, * data2 ;
+    int retval ;
+    int count ;
+    
+    data1 = key1->data ;
+    data2 = key2->data ;
+
+    /* As newSVpv will assume that the data pointer is a null terminated C 
+       string if the size parameter is 0, make sure that data points to an 
+       empty string if the length is 0
+    */
+    if (key1->size == 0)
+        data1 = "" ;
+    if (key2->size == 0)
+        data2 = "" ;
+
+    ENTER ;
+    SAVETMPS;
+
+    PUSHMARK(SP) ;
+    EXTEND(SP,2) ;
+    PUSHs(sv_2mortal(newSVpv(data1,key1->size)));
+    PUSHs(sv_2mortal(newSVpv(data2,key2->size)));
+    PUTBACK ;
+
+    count = perl_call_sv(CurrentDB->prefix, G_SCALAR); 
+
+    SPAGAIN ;
+
+    if (count != 1)
+        croak ("DB_File btree_prefix: expected 1 return value from prefix sub, got %d\n", count) ;
+ 
+    retval = POPi ;
+ 
+    PUTBACK ;
+    FREETMPS ;
+    LEAVE ;
+
+    return (retval) ;
+}
+
+static DB_Hash_t
+hash_cb(data, size)
+const void * data ;
+size_t size ;
+{
+    dSP ;
+    int retval ;
+    int count ;
+
+    if (size == 0)
+        data = "" ;
+
+     /* DGH - Next two lines added to fix corrupted stack problem */
+    ENTER ;
+    SAVETMPS;
+
+    PUSHMARK(SP) ;
+
+    XPUSHs(sv_2mortal(newSVpv((char*)data,size)));
+    PUTBACK ;
+
+    count = perl_call_sv(CurrentDB->hash, G_SCALAR); 
+
+    SPAGAIN ;
+
+    if (count != 1)
+        croak ("DB_File hash_cb: expected 1 return value from hash sub, got %d\n", count) ;
+
+    retval = POPi ;
+
+    PUTBACK ;
+    FREETMPS ;
+    LEAVE ;
+
+    return (retval) ;
+}
+
+
+#ifdef TRACE
+
+static void
+PrintHash(hash)
+INFO * hash ;
+{
+    printf ("HASH Info\n") ;
+    printf ("  hash      = %s\n", 
+		(hash->db_HA_hash != NULL ? "redefined" : "default")) ;
+    printf ("  bsize     = %d\n", hash->db_HA_bsize) ;
+    printf ("  ffactor   = %d\n", hash->db_HA_ffactor) ;
+    printf ("  nelem     = %d\n", hash->db_HA_nelem) ;
+    printf ("  cachesize = %d\n", hash->db_HA_cachesize) ;
+    printf ("  lorder    = %d\n", hash->db_HA_lorder) ;
+
+}
+
+static void
+PrintRecno(recno)
+INFO * recno ;
+{
+    printf ("RECNO Info\n") ;
+    printf ("  flags     = %d\n", recno->db_RE_flags) ;
+    printf ("  cachesize = %d\n", recno->db_RE_cachesize) ;
+    printf ("  psize     = %d\n", recno->db_RE_psize) ;
+    printf ("  lorder    = %d\n", recno->db_RE_lorder) ;
+    printf ("  reclen    = %ul\n", (unsigned long)recno->db_RE_reclen) ;
+    printf ("  bval      = %d 0x%x\n", recno->db_RE_bval, recno->db_RE_bval) ;
+    printf ("  bfname    = %d [%s]\n", recno->db_RE_bfname, recno->db_RE_bfname) ;
+}
+
+static void
+PrintBtree(btree)
+INFO * btree ;
+{
+    printf ("BTREE Info\n") ;
+    printf ("  compare    = %s\n", 
+		(btree->db_BT_compare ? "redefined" : "default")) ;
+    printf ("  prefix     = %s\n", 
+		(btree->db_BT_prefix ? "redefined" : "default")) ;
+    printf ("  flags      = %d\n", btree->db_BT_flags) ;
+    printf ("  cachesize  = %d\n", btree->db_BT_cachesize) ;
+    printf ("  psize      = %d\n", btree->db_BT_psize) ;
+#ifndef DB_VERSION_MAJOR
+    printf ("  maxkeypage = %d\n", btree->db_BT_maxkeypage) ;
+    printf ("  minkeypage = %d\n", btree->db_BT_minkeypage) ;
+#endif
+    printf ("  lorder     = %d\n", btree->db_BT_lorder) ;
+}
+
+#else
+
+#define PrintRecno(recno)
+#define PrintHash(hash)
+#define PrintBtree(btree)
+
+#endif /* TRACE */
+
+
+static I32
+GetArrayLength(db)
+DB_File db ;
+{
+    DBT		key ;
+    DBT		value ;
+    int		RETVAL ;
+
+    DBT_flags(key) ;
+    DBT_flags(value) ;
+    RETVAL = do_SEQ(db, key, value, R_LAST) ;
+    if (RETVAL == 0)
+        RETVAL = *(I32 *)key.data ;
+    else /* No key means empty file */
+        RETVAL = 0 ;
+
+    return ((I32)RETVAL) ;
+}
+
+static recno_t
+GetRecnoKey(db, value)
+DB_File  db ;
+I32      value ;
+{
+    if (value < 0) {
+	/* Get the length of the array */
+	I32 length = GetArrayLength(db) ;
+
+	/* check for attempt to write before start of array */
+	if (length + value + 1 <= 0)
+	    croak("Modification of non-creatable array value attempted, subscript %ld", (long)value) ;
+
+	value = length + value + 1 ;
+    }
+    else
+        ++ value ;
+
+    return value ;
+}
+
+static DB_File
+ParseOpenInfo(isHASH, name, flags, mode, sv)
+int    isHASH ;
+char * name ;
+int    flags ;
+int    mode ;
+SV *   sv ;
+{
+    SV **	svp;
+    HV *	action ;
+    DB_File	RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
+    void *	openinfo = NULL ;
+    INFO	* info  = &RETVAL->info ;
+
+/* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ;  */
+    Zero(RETVAL, 1, DB_File_type) ;
+
+    /* Default to HASH */
+    RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
+    RETVAL->type = DB_HASH ;
+
+     /* DGH - Next line added to avoid SEGV on existing hash DB */
+    CurrentDB = RETVAL; 
+
+    /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
+    RETVAL->in_memory = (name == NULL) ;
+
+    if (sv)
+    {
+        if (! SvROK(sv) )
+            croak ("type parameter is not a reference") ;
+
+        svp  = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
+        if (svp && SvOK(*svp))
+            action  = (HV*) SvRV(*svp) ;
+	else
+	    croak("internal error") ;
+
+        if (sv_isa(sv, "DB_File::HASHINFO"))
+        {
+
+	    if (!isHASH)
+	        croak("DB_File can only tie an associative array to a DB_HASH database") ;
+
+            RETVAL->type = DB_HASH ;
+            openinfo = (void*)info ;
+  
+            svp = hv_fetch(action, "hash", 4, FALSE); 
+
+            if (svp && SvOK(*svp))
+            {
+                info->db_HA_hash = hash_cb ;
+		RETVAL->hash = newSVsv(*svp) ;
+            }
+            else
+	        info->db_HA_hash = NULL ;
+
+           svp = hv_fetch(action, "ffactor", 7, FALSE);
+           info->db_HA_ffactor = svp ? SvIV(*svp) : 0;
+         
+           svp = hv_fetch(action, "nelem", 5, FALSE);
+           info->db_HA_nelem = svp ? SvIV(*svp) : 0;
+         
+           svp = hv_fetch(action, "bsize", 5, FALSE);
+           info->db_HA_bsize = svp ? SvIV(*svp) : 0;
+           
+           svp = hv_fetch(action, "cachesize", 9, FALSE);
+           info->db_HA_cachesize = svp ? SvIV(*svp) : 0;
+         
+           svp = hv_fetch(action, "lorder", 6, FALSE);
+           info->db_HA_lorder = svp ? SvIV(*svp) : 0;
+
+           PrintHash(info) ; 
+        }
+        else if (sv_isa(sv, "DB_File::BTREEINFO"))
+        {
+	    if (!isHASH)
+	        croak("DB_File can only tie an associative array to a DB_BTREE database");
+
+            RETVAL->type = DB_BTREE ;
+            openinfo = (void*)info ;
+   
+            svp = hv_fetch(action, "compare", 7, FALSE);
+            if (svp && SvOK(*svp))
+            {
+                info->db_BT_compare = btree_compare ;
+		RETVAL->compare = newSVsv(*svp) ;
+            }
+            else
+                info->db_BT_compare = NULL ;
+
+            svp = hv_fetch(action, "prefix", 6, FALSE);
+            if (svp && SvOK(*svp))
+            {
+                info->db_BT_prefix = btree_prefix ;
+		RETVAL->prefix = newSVsv(*svp) ;
+            }
+            else
+                info->db_BT_prefix = NULL ;
+
+            svp = hv_fetch(action, "flags", 5, FALSE);
+            info->db_BT_flags = svp ? SvIV(*svp) : 0;
+   
+            svp = hv_fetch(action, "cachesize", 9, FALSE);
+            info->db_BT_cachesize = svp ? SvIV(*svp) : 0;
+         
+#ifndef DB_VERSION_MAJOR
+            svp = hv_fetch(action, "minkeypage", 10, FALSE);
+            info->btree.minkeypage = svp ? SvIV(*svp) : 0;
+        
+            svp = hv_fetch(action, "maxkeypage", 10, FALSE);
+            info->btree.maxkeypage = svp ? SvIV(*svp) : 0;
+#endif
+
+            svp = hv_fetch(action, "psize", 5, FALSE);
+            info->db_BT_psize = svp ? SvIV(*svp) : 0;
+         
+            svp = hv_fetch(action, "lorder", 6, FALSE);
+            info->db_BT_lorder = svp ? SvIV(*svp) : 0;
+
+            PrintBtree(info) ;
+         
+        }
+        else if (sv_isa(sv, "DB_File::RECNOINFO"))
+        {
+	    if (isHASH)
+	        croak("DB_File can only tie an array to a DB_RECNO database");
+
+            RETVAL->type = DB_RECNO ;
+            openinfo = (void *)info ;
+
+	    info->db_RE_flags = 0 ;
+
+            svp = hv_fetch(action, "flags", 5, FALSE);
+            info->db_RE_flags = (u_long) (svp ? SvIV(*svp) : 0);
+         
+            svp = hv_fetch(action, "reclen", 6, FALSE);
+            info->db_RE_reclen = (size_t) (svp ? SvIV(*svp) : 0);
+         
+            svp = hv_fetch(action, "cachesize", 9, FALSE);
+            info->db_RE_cachesize = (u_int) (svp ? SvIV(*svp) : 0);
+         
+            svp = hv_fetch(action, "psize", 5, FALSE);
+            info->db_RE_psize = (u_int) (svp ? SvIV(*svp) : 0);
+         
+            svp = hv_fetch(action, "lorder", 6, FALSE);
+            info->db_RE_lorder = (int) (svp ? SvIV(*svp) : 0);
+
+#ifdef DB_VERSION_MAJOR
+	    info->re_source = name ;
+	    name = NULL ;
+#endif
+            svp = hv_fetch(action, "bfname", 6, FALSE); 
+            if (svp && SvOK(*svp)) {
+		char * ptr = SvPV(*svp,PL_na) ;
+#ifdef DB_VERSION_MAJOR
+		name = (char*) PL_na ? ptr : NULL ;
+#else
+                info->db_RE_bfname = (char*) (PL_na ? ptr : NULL) ;
+#endif
+	    }
+	    else
+#ifdef DB_VERSION_MAJOR
+		name = NULL ;
+#else
+                info->db_RE_bfname = NULL ;
+#endif
+         
+	    svp = hv_fetch(action, "bval", 4, FALSE);
+#ifdef DB_VERSION_MAJOR
+            if (svp && SvOK(*svp))
+            {
+		int value ;
+                if (SvPOK(*svp))
+		    value = (int)*SvPV(*svp, PL_na) ;
+		else
+		    value = SvIV(*svp) ;
+
+		if (info->flags & DB_FIXEDLEN) {
+		    info->re_pad = value ;
+		    info->flags |= DB_PAD ;
+		}
+		else {
+		    info->re_delim = value ;
+		    info->flags |= DB_DELIMITER ;
+		}
+
+            }
+#else
+            if (svp && SvOK(*svp))
+            {
+                if (SvPOK(*svp))
+		    info->db_RE_bval = (u_char)*SvPV(*svp, PL_na) ;
+		else
+		    info->db_RE_bval = (u_char)(unsigned long) SvIV(*svp) ;
+		DB_flags(info->flags, DB_DELIMITER) ;
+
+            }
+            else
+ 	    {
+		if (info->db_RE_flags & R_FIXEDLEN)
+                    info->db_RE_bval = (u_char) ' ' ;
+		else
+                    info->db_RE_bval = (u_char) '\n' ;
+		DB_flags(info->flags, DB_DELIMITER) ;
+	    }
+#endif
+
+#ifdef DB_RENUMBER
+	    info->flags |= DB_RENUMBER ;
+#endif
+         
+            PrintRecno(info) ;
+        }
+        else
+            croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
+    }
+
+
+    /* OS2 Specific Code */
+#ifdef OS2
+#ifdef __EMX__
+    flags |= O_BINARY;
+#endif /* __EMX__ */
+#endif /* OS2 */
+
+#ifdef DB_VERSION_MAJOR
+
+    {
+        int	 	Flags = 0 ;
+        int		status ;
+
+        /* Map 1.x flags to 2.x flags */
+        if ((flags & O_CREAT) == O_CREAT)
+            Flags |= DB_CREATE ;
+
+#ifdef O_NONBLOCK
+        if ((flags & O_NONBLOCK) == O_NONBLOCK)
+            Flags |= DB_EXCL ;
+#endif
+
+#if O_RDONLY == 0
+        if (flags == O_RDONLY)
+#else
+        if (flags & O_RDONLY) == O_RDONLY)
+#endif
+            Flags |= DB_RDONLY ;
+
+#ifdef O_NONBLOCK
+        if ((flags & O_TRUNC) == O_TRUNC)
+            Flags |= DB_TRUNCATE ;
+#endif
+
+        status = db_open(name, RETVAL->type, Flags, mode, NULL, openinfo, &RETVAL->dbp) ; 
+        if (status == 0)
+            status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor) ;
+
+        if (status)
+	    RETVAL->dbp = NULL ;
+
+    }
+#else
+    RETVAL->dbp = dbopen(name, flags, mode, RETVAL->type, openinfo) ; 
+#endif
+
+    return (RETVAL) ;
+}
+
+
+static int
+not_here(s)
+char *s;
+{
+    croak("DB_File::%s not implemented on this architecture", s);
+    return -1;
+}
+
+static double 
+constant(name, arg)
+char *name;
+int arg;
+{
+    errno = 0;
+    switch (*name) {
+    case 'A':
+	break;
+    case 'B':
+	if (strEQ(name, "BTREEMAGIC"))
+#ifdef BTREEMAGIC
+	    return BTREEMAGIC;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "BTREEVERSION"))
+#ifdef BTREEVERSION
+	    return BTREEVERSION;
+#else
+	    goto not_there;
+#endif
+	break;
+    case 'C':
+	break;
+    case 'D':
+	if (strEQ(name, "DB_LOCK"))
+#ifdef DB_LOCK
+	    return DB_LOCK;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "DB_SHMEM"))
+#ifdef DB_SHMEM
+	    return DB_SHMEM;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "DB_TXN"))
+#ifdef DB_TXN
+	    return (U32)DB_TXN;
+#else
+	    goto not_there;
+#endif
+	break;
+    case 'E':
+	break;
+    case 'F':
+	break;
+    case 'G':
+	break;
+    case 'H':
+	if (strEQ(name, "HASHMAGIC"))
+#ifdef HASHMAGIC
+	    return HASHMAGIC;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "HASHVERSION"))
+#ifdef HASHVERSION
+	    return HASHVERSION;
+#else
+	    goto not_there;
+#endif
+	break;
+    case 'I':
+	break;
+    case 'J':
+	break;
+    case 'K':
+	break;
+    case 'L':
+	break;
+    case 'M':
+	if (strEQ(name, "MAX_PAGE_NUMBER"))
+#ifdef MAX_PAGE_NUMBER
+	    return (U32)MAX_PAGE_NUMBER;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "MAX_PAGE_OFFSET"))
+#ifdef MAX_PAGE_OFFSET
+	    return MAX_PAGE_OFFSET;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "MAX_REC_NUMBER"))
+#ifdef MAX_REC_NUMBER
+	    return (U32)MAX_REC_NUMBER;
+#else
+	    goto not_there;
+#endif
+	break;
+    case 'N':
+	break;
+    case 'O':
+	break;
+    case 'P':
+	break;
+    case 'Q':
+	break;
+    case 'R':
+	if (strEQ(name, "RET_ERROR"))
+#ifdef RET_ERROR
+	    return RET_ERROR;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "RET_SPECIAL"))
+#ifdef RET_SPECIAL
+	    return RET_SPECIAL;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "RET_SUCCESS"))
+#ifdef RET_SUCCESS
+	    return RET_SUCCESS;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "R_CURSOR"))
+#ifdef R_CURSOR
+	    return R_CURSOR;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "R_DUP"))
+#ifdef R_DUP
+	    return R_DUP;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "R_FIRST"))
+#ifdef R_FIRST
+	    return R_FIRST;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "R_FIXEDLEN"))
+#ifdef R_FIXEDLEN
+	    return R_FIXEDLEN;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "R_IAFTER"))
+#ifdef R_IAFTER
+	    return R_IAFTER;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "R_IBEFORE"))
+#ifdef R_IBEFORE
+	    return R_IBEFORE;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "R_LAST"))
+#ifdef R_LAST
+	    return R_LAST;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "R_NEXT"))
+#ifdef R_NEXT
+	    return R_NEXT;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "R_NOKEY"))
+#ifdef R_NOKEY
+	    return R_NOKEY;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "R_NOOVERWRITE"))
+#ifdef R_NOOVERWRITE
+	    return R_NOOVERWRITE;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "R_PREV"))
+#ifdef R_PREV
+	    return R_PREV;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "R_RECNOSYNC"))
+#ifdef R_RECNOSYNC
+	    return R_RECNOSYNC;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "R_SETCURSOR"))
+#ifdef R_SETCURSOR
+	    return R_SETCURSOR;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "R_SNAPSHOT"))
+#ifdef R_SNAPSHOT
+	    return R_SNAPSHOT;
+#else
+	    goto not_there;
+#endif
+	break;
+    case 'S':
+	break;
+    case 'T':
+	break;
+    case 'U':
+	break;
+    case 'V':
+	break;
+    case 'W':
+	break;
+    case 'X':
+	break;
+    case 'Y':
+	break;
+    case 'Z':
+	break;
+    case '_':
+	break;
+    }
+    errno = EINVAL;
+    return 0;
+
+not_there:
+    errno = ENOENT;
+    return 0;
+}
+
+MODULE = DB_File	PACKAGE = DB_File	PREFIX = db_
+
+BOOT:
+  {
+    GetVersionInfo() ;
+ 
+    empty.data = &zero ;
+    empty.size =  sizeof(recno_t) ;
+    DBT_flags(empty) ; 
+  }
+
+double
+constant(name,arg)
+	char *		name
+	int		arg
+
+
+DB_File
+db_DoTie_(isHASH, dbtype, name=undef, flags=O_CREAT|O_RDWR, mode=0666, type=DB_HASH)
+	int		isHASH
+	char *		dbtype
+	int		flags
+	int		mode
+	CODE:
+	{
+	    char *	name = (char *) NULL ; 
+	    SV *	sv = (SV *) NULL ; 
+
+	    if (items >= 3 && SvOK(ST(2))) 
+	        name = (char*) SvPV(ST(2), PL_na) ; 
+
+            if (items == 6)
+	        sv = ST(5) ;
+
+	    RETVAL = ParseOpenInfo(isHASH, name, flags, mode, sv) ;
+	    if (RETVAL->dbp == NULL)
+	        RETVAL = NULL ;
+	}
+	OUTPUT:	
+	    RETVAL
+
+int
+db_DESTROY(db)
+	DB_File		db
+	INIT:
+	  CurrentDB = db ;
+	CLEANUP:
+	  if (db->hash)
+	    SvREFCNT_dec(db->hash) ;
+	  if (db->compare)
+	    SvREFCNT_dec(db->compare) ;
+	  if (db->prefix)
+	    SvREFCNT_dec(db->prefix) ;
+	  Safefree(db) ;
+#ifdef DB_VERSION_MAJOR
+	  if (RETVAL > 0)
+	    RETVAL = -1 ;
+#endif
+
+
+int
+db_DELETE(db, key, flags=0)
+	DB_File		db
+	DBTKEY		key
+	u_int		flags
+	INIT:
+	  CurrentDB = db ;
+
+
+int
+db_EXISTS(db, key)
+	DB_File		db
+	DBTKEY		key
+	CODE:
+	{
+          DBT		value ;
+	
+	  DBT_flags(value) ; 
+	  CurrentDB = db ;
+	  RETVAL = (((db->dbp)->get)(db->dbp, TXN &key, &value, 0) == 0) ;
+	}
+	OUTPUT:
+	  RETVAL
+
+int
+db_FETCH(db, key, flags=0)
+	DB_File		db
+	DBTKEY		key
+	u_int		flags
+	CODE:
+	{
+            DBT		value ;
+
+	    DBT_flags(value) ; 
+	    CurrentDB = db ;
+	    /* RETVAL = ((db->dbp)->get)(db->dbp, TXN &key, &value, flags) ; */
+	    RETVAL = db_get(db, key, value, flags) ;
+	    ST(0) = sv_newmortal();
+	    OutputValue(ST(0), value)
+	}
+
+int
+db_STORE(db, key, value, flags=0)
+	DB_File		db
+	DBTKEY		key
+	DBT		value
+	u_int		flags
+	INIT:
+	  CurrentDB = db ;
+
+
+int
+db_FIRSTKEY(db)
+	DB_File		db
+	CODE:
+	{
+	    DBTKEY	key ;
+	    DBT		value ;
+	    DB *	Db = db->dbp ;
+
+	    DBT_flags(key) ; 
+	    DBT_flags(value) ; 
+	    CurrentDB = db ;
+	    RETVAL = do_SEQ(db, key, value, R_FIRST) ;
+	    ST(0) = sv_newmortal();
+	    OutputKey(ST(0), key) ;
+	}
+
+int
+db_NEXTKEY(db, key)
+	DB_File		db
+	DBTKEY		key
+	CODE:
+	{
+	    DBT		value ;
+	    DB *	Db = db->dbp ;
+
+	    DBT_flags(value) ; 
+	    CurrentDB = db ;
+	    RETVAL = do_SEQ(db, key, value, R_NEXT) ;
+	    ST(0) = sv_newmortal();
+	    OutputKey(ST(0), key) ;
+	}
+
+#
+# These would be nice for RECNO
+#
+
+int
+unshift(db, ...)
+	DB_File		db
+	ALIAS:		UNSHIFT = 1
+	CODE:
+	{
+	    DBTKEY	key ;
+	    DBT		value ;
+	    int		i ;
+	    int		One ;
+	    DB *	Db = db->dbp ;
+
+	    DBT_flags(key) ; 
+	    DBT_flags(value) ; 
+	    CurrentDB = db ;
+#ifdef DB_VERSION_MAJOR
+	    /* get the first value */
+	    RETVAL = do_SEQ(db, key, value, DB_FIRST) ;	 
+	    RETVAL = 0 ;
+#else
+	    RETVAL = -1 ;
+#endif
+	    for (i = items-1 ; i > 0 ; --i)
+	    {
+	        value.data = SvPV(ST(i), PL_na) ;
+	        value.size = PL_na ;
+	        One = 1 ;
+	        key.data = &One ;
+	        key.size = sizeof(int) ;
+#ifdef DB_VERSION_MAJOR
+           	RETVAL = (db->cursor->c_put)(db->cursor, &key, &value, DB_BEFORE) ;
+#else
+	        RETVAL = (Db->put)(Db, &key, &value, R_IBEFORE) ;
+#endif
+	        if (RETVAL != 0)
+	            break;
+	    }
+	}
+	OUTPUT:
+	    RETVAL
+
+I32
+pop(db)
+	DB_File		db
+	ALIAS:		POP = 1
+	CODE:
+	{
+	    DBTKEY	key ;
+	    DBT		value ;
+	    DB *	Db = db->dbp ;
+
+	    DBT_flags(key) ; 
+	    DBT_flags(value) ; 
+	    CurrentDB = db ;
+
+	    /* First get the final value */
+	    RETVAL = do_SEQ(db, key, value, R_LAST) ;	 
+	    ST(0) = sv_newmortal();
+	    /* Now delete it */
+	    if (RETVAL == 0)
+	    {
+		/* the call to del will trash value, so take a copy now */
+		OutputValue(ST(0), value) ;
+	        RETVAL = db_del(db, key, R_CURSOR) ;
+	        if (RETVAL != 0) 
+	            sv_setsv(ST(0), &PL_sv_undef); 
+	    }
+	}
+
+I32
+shift(db)
+	DB_File		db
+	ALIAS:		SHIFT = 1
+	CODE:
+	{
+	    DBT		value ;
+	    DBTKEY	key ;
+	    DB *	Db = db->dbp ;
+
+	    DBT_flags(key) ; 
+	    DBT_flags(value) ; 
+	    CurrentDB = db ;
+	    /* get the first value */
+	    RETVAL = do_SEQ(db, key, value, R_FIRST) ;	 
+	    ST(0) = sv_newmortal();
+	    /* Now delete it */
+	    if (RETVAL == 0)
+	    {
+		/* the call to del will trash value, so take a copy now */
+		OutputValue(ST(0), value) ;
+	        RETVAL = db_del(db, key, R_CURSOR) ;
+	        if (RETVAL != 0)
+	            sv_setsv (ST(0), &PL_sv_undef) ;
+	    }
+	}
+
+
+I32
+push(db, ...)
+	DB_File		db
+	ALIAS:		PUSH = 1
+	CODE:
+	{
+	    DBTKEY	key ;
+	    DBTKEY *	keyptr = &key ; 
+	    DBT		value ;
+	    DB *	Db = db->dbp ;
+	    int		i ;
+
+	    DBT_flags(key) ; 
+	    DBT_flags(value) ; 
+	    CurrentDB = db ;
+	    /* Set the Cursor to the Last element */
+	    RETVAL = do_SEQ(db, key, value, R_LAST) ;
+	    if (RETVAL >= 0)
+	    {
+		if (RETVAL == 1)
+		    keyptr = &empty ;
+#ifdef DB_VERSION_MAJOR
+	        for (i = 1 ; i < items  ; ++i)
+	        {
+		    
+		    ++ (* (int*)key.data) ;
+	            value.data = SvPV(ST(i), PL_na) ;
+	            value.size = PL_na ;
+	            RETVAL = (Db->put)(Db, NULL, &key, &value, 0) ;
+	            if (RETVAL != 0)
+	                break;
+		}
+#else
+	        for (i = items - 1 ; i > 0 ; --i)
+	        {
+	            value.data = SvPV(ST(i), PL_na) ;
+	            value.size = PL_na ;
+	            RETVAL = (Db->put)(Db, keyptr, &value, R_IAFTER) ;
+	            if (RETVAL != 0)
+	                break;
+	        }
+#endif
+	    }
+	}
+	OUTPUT:
+	    RETVAL
+
+
+I32
+length(db)
+	DB_File		db
+	ALIAS:		FETCHSIZE = 1
+	CODE:
+	    CurrentDB = db ;
+	    RETVAL = GetArrayLength(db) ;
+	OUTPUT:
+	    RETVAL
+
+
+#
+# Now provide an interface to the rest of the DB functionality
+#
+
+int
+db_del(db, key, flags=0)
+	DB_File		db
+	DBTKEY		key
+	u_int		flags
+	CODE:
+	  CurrentDB = db ;
+	  RETVAL = db_del(db, key, flags) ;
+#ifdef DB_VERSION_MAJOR
+	  if (RETVAL > 0)
+	    RETVAL = -1 ;
+	  else if (RETVAL == DB_NOTFOUND)
+	    RETVAL = 1 ;
+#endif
+	OUTPUT:
+	  RETVAL
+
+
+int
+db_get(db, key, value, flags=0)
+	DB_File		db
+	DBTKEY		key
+	DBT		value = NO_INIT
+	u_int		flags
+	CODE:
+	  CurrentDB = db ;
+	  DBT_flags(value) ; 
+	  RETVAL = db_get(db, key, value, flags) ;
+#ifdef DB_VERSION_MAJOR
+	  if (RETVAL > 0)
+	    RETVAL = -1 ;
+	  else if (RETVAL == DB_NOTFOUND)
+	    RETVAL = 1 ;
+#endif
+	OUTPUT:
+	  RETVAL
+	  value
+
+int
+db_put(db, key, value, flags=0)
+	DB_File		db
+	DBTKEY		key
+	DBT		value
+	u_int		flags
+	CODE:
+	  CurrentDB = db ;
+	  RETVAL = db_put(db, key, value, flags) ;
+#ifdef DB_VERSION_MAJOR
+	  if (RETVAL > 0)
+	    RETVAL = -1 ;
+	  else if (RETVAL == DB_KEYEXIST)
+	    RETVAL = 1 ;
+#endif
+	OUTPUT:
+	  RETVAL
+	  key		if (flags & (R_IAFTER|R_IBEFORE)) OutputKey(ST(1), key);
+
+int
+db_fd(db)
+	DB_File		db
+	int		status = 0 ;
+	CODE:
+	  CurrentDB = db ;
+#ifdef DB_VERSION_MAJOR
+	  RETVAL = -1 ;
+	  status = (db->in_memory
+		? -1 
+		: ((db->dbp)->fd)(db->dbp, &RETVAL) ) ;
+	  if (status != 0)
+	    RETVAL = -1 ;
+#else
+	  RETVAL = (db->in_memory
+		? -1 
+		: ((db->dbp)->fd)(db->dbp) ) ;
+#endif
+	OUTPUT:
+	  RETVAL
+
+int
+db_sync(db, flags=0)
+	DB_File		db
+	u_int		flags
+	CODE:
+	  CurrentDB = db ;
+	  RETVAL = db_sync(db, flags) ;
+#ifdef DB_VERSION_MAJOR
+	  if (RETVAL > 0)
+	    RETVAL = -1 ;
+#endif
+	OUTPUT:
+	  RETVAL
+
+
+int
+db_seq(db, key, value, flags)
+	DB_File		db
+	DBTKEY		key 
+	DBT		value = NO_INIT
+	u_int		flags
+	CODE:
+	  CurrentDB = db ;
+	  DBT_flags(value) ; 
+	  RETVAL = db_seq(db, key, value, flags);
+#ifdef DB_VERSION_MAJOR
+	  if (RETVAL > 0)
+	    RETVAL = -1 ;
+	  else if (RETVAL == DB_NOTFOUND)
+	    RETVAL = 1 ;
+#endif
+	OUTPUT:
+	  RETVAL
+	  key
+	  value
+
diff --git a/contrib/perl5/ext/DB_File/DB_File_BS b/contrib/perl5/ext/DB_File/DB_File_BS
new file mode 100644
index 0000000..9282c49
--- /dev/null
+++ b/contrib/perl5/ext/DB_File/DB_File_BS
@@ -0,0 +1,6 @@
+# NeXT needs /usr/lib/libposix.a to load along with DB_File.so
+if ( $dlsrc eq "dl_next.xs" ) {
+    @DynaLoader::dl_resolve_using = ( '/usr/lib/libposix.a' );
+}
+
+1;
diff --git a/contrib/perl5/ext/DB_File/Makefile.PL b/contrib/perl5/ext/DB_File/Makefile.PL
new file mode 100644
index 0000000..dbe19f1
--- /dev/null
+++ b/contrib/perl5/ext/DB_File/Makefile.PL
@@ -0,0 +1,20 @@
+use ExtUtils::MakeMaker 5.16 ;
+use Config ;
+
+# OS2 is a special case, so check for it now.
+my $OS2 = "-DOS2" if $Config{'osname'} eq 'os2' ;
+
+my $LIB = "-ldb" ;
+# so is win32
+$LIB = "-llibdb" if $^O eq 'MSWin32' ;
+
+WriteMakefile(
+	NAME 		=> 'DB_File',
+	LIBS 		=> ["-L/usr/local/lib $LIB"],
+        MAN3PODS        => ' ',         # Pods will be built by installman.
+	#INC		=> '-I/usr/local/include',
+	VERSION_FROM	=> 'DB_File.pm',
+	XSPROTOARG	=> '-noprototypes',
+	DEFINE		=> "$OS2",
+	);
+
diff --git a/contrib/perl5/ext/DB_File/dbinfo b/contrib/perl5/ext/DB_File/dbinfo
new file mode 100644
index 0000000..9640ba4
--- /dev/null
+++ b/contrib/perl5/ext/DB_File/dbinfo
@@ -0,0 +1,96 @@
+#!/usr/local/bin/perl
+
+# Name:		dbinfo -- identify berkeley DB version used to create 
+#			  a database file
+#
+# Author:	Paul Marquess
+# Version: 	1.01 
+# Date		16th April 1998
+#
+#     Copyright (c) 1998 Paul Marquess. All rights reserved.
+#     This program is free software; you can redistribute it and/or
+#     modify it under the same terms as Perl itself.
+
+# Todo: Print more stats on a db file, e.g. no of records
+#       add log/txn/lock files
+
+use strict ;
+
+my %Data =
+	(
+	0x053162 =>	{
+			  Type 	=> "Btree",
+			  Versions => 
+				{
+				  1	=> "Unknown (older than 1.71)",
+				  2	=> "Unknown (older than 1.71)",
+				  3	=> "1.71 -> 1.85, 1.86",
+				  4	=> "Unknown",
+				  5	=> "2.0.0 -> 2.3.0",
+				  6	=> "2.3.1 or greater",
+				}
+			},
+	0x061561 => 	{
+			  Type => "Hash",
+			  Versions =>
+				{
+				  1	=> "Unknown (older than 1.71)",
+        			  2     => "1.71 -> 1.85",
+        			  3     => "1.86",
+        			  4     => "2.0.0 -> 2.1.0",
+        			  5     => "2.2.6 or greater",
+				}
+			},
+	) ;
+
+die "Usage: dbinfo file\n" unless @ARGV == 1 ;
+
+print "testing file $ARGV[0]...\n\n" ;
+open (F, "<$ARGV[0]") or die "Cannot open file $ARGV[0]: $!\n" ;
+
+my $buff ;
+read F, $buff, 20 ;
+
+my (@info) = unpack("NNNNN", $buff) ;
+my (@info1) = unpack("VVVVV", $buff) ;
+my ($magic, $version, $endian) ;
+
+if ($Data{$info[0]}) # first try DB 1.x format
+{
+    $magic = $info[0] ;
+    $version = $info[1] ;
+    $endian  = "Unknown" ;
+}
+elsif ($Data{$info[3]}) # next DB 2.x big endian
+{
+    $magic = $info[3] ;
+    $version = $info[4] ;
+    $endian  = "Big Endian" ;
+}
+elsif ($Data{$info1[3]}) # next DB 2.x little endian
+{
+    $magic = $info1[3] ;
+    $version = $info1[4] ;
+    $endian  = "Little Endian" ;
+}
+else
+  { die "not a Berkeley DB database file.\n" }
+
+my $type = $Data{$magic} ;
+my $magic = sprintf "%06X", $magic ;
+
+my $ver_string = "Unknown" ;
+$ver_string = $type->{Versions}{$version}
+	if defined $type->{Versions}{$version} ;
+
+print <<EOM ;
+File Type:		Berkeley DB $type->{Type} file.
+File Version ID:	$version
+Built with Berkeley DB:	$ver_string
+Byte Order:		$endian
+Magic:			$magic
+EOM
+
+close F ;
+
+exit ;
diff --git a/contrib/perl5/ext/DB_File/typemap b/contrib/perl5/ext/DB_File/typemap
new file mode 100644
index 0000000..7af55ae
--- /dev/null
+++ b/contrib/perl5/ext/DB_File/typemap
@@ -0,0 +1,41 @@
+# typemap for Perl 5 interface to Berkeley 
+#
+# written by Paul Marquess (pmarquess@bfsec.bt.co.uk)
+# last modified 13th May 1998
+# version 1.59
+#
+#################################### DB SECTION
+#
+# 
+
+u_int			T_U_INT
+DB_File			T_PTROBJ
+DBT			T_dbtdatum
+DBTKEY			T_dbtkeydatum
+
+INPUT
+T_dbtkeydatum
+	if (db->type != DB_RECNO) {
+	    $var.data = SvPV($arg, PL_na);
+	    $var.size = (int)PL_na;
+	    DBT_flags($var);
+	}
+	else {
+	    Value =  GetRecnoKey(db, SvIV($arg)) ; 
+	    $var.data = & Value; 
+	    $var.size = (int)sizeof(recno_t);
+	    DBT_flags($var);
+	}
+T_dbtdatum
+	$var.data = SvPV($arg, PL_na);
+	$var.size = (int)PL_na;
+	DBT_flags($var);
+
+OUTPUT
+
+T_dbtkeydatum
+	OutputKey($arg, $var)
+T_dbtdatum
+	OutputValue($arg, $var)
+T_PTROBJ
+        sv_setref_pv($arg, dbtype, (void*)$var);
diff --git a/contrib/perl5/ext/Data/Dumper/Changes b/contrib/perl5/ext/Data/Dumper/Changes
new file mode 100644
index 0000000..a164958
--- /dev/null
+++ b/contrib/perl5/ext/Data/Dumper/Changes
@@ -0,0 +1,160 @@
+=head1 NAME
+
+HISTORY - public release history for Data::Dumper
+
+=head1 DESCRIPTION
+
+=over 8
+
+=item 2.09  (9 July 1998)
+
+Implement $Data::Dumper::Bless, suggested by Mark Daku <daku@nortel.ca>.
+
+=item 2.081  (15 January 1998)
+
+Minor release to fix Makefile.PL not accepting MakeMaker args.
+
+=item 2.08  (7 December 1997)
+
+Glob dumps don't output superflous 'undef' anymore.
+
+Fixes from Gisle Aas <gisle@aas.no> to make Dumper() work with
+overloaded strings in recent perls, and his new testsuite.
+
+require 5.004.
+
+A separate flag to always quote hash keys (on by default).
+
+Recreating known CODE refs is now better supported.
+
+Changed flawed constant SCALAR bless workaround.
+
+=item 2.07  (7 December 1996)
+
+Dumpxs output is now exactly the same as Dump.  It still doesn't
+honor C<Useqq> though.
+
+Regression tests test for identical output and C<eval>-ability.
+
+Bug in *GLOB{THING} output fixed.
+
+Other small enhancements.
+
+=item 2.06  (2 December 1996)
+
+Bugfix that was serious enough for new release--the bug cripples
+MLDBM.  Problem was "Attempt to modify readonly value..." failures
+that stemmed for a misguided SvPV_force() instead of a SvPV().)
+
+=item 2.05  (2 December 1996)
+
+Fixed the type mismatch that was causing Dumpxs test to fail
+on 64-bit platforms.
+
+GLOB elements are dumped now when C<Purity> is set (using the
+*GLOB{THING} syntax).
+
+The C<Freezer> option can be set to a method name to call
+before probing objects for dumping.  Some applications: objects with
+external data, can re-bless themselves into a transitional package;
+Objects the maintain ephemeral state (like open files) can put
+additional information in the object to facilitate persistence.
+
+The corresponding C<Toaster> option, if set, specifies
+the method call that will revive the frozen object.
+
+The C<Deepcopy> flag has been added to do just that.
+
+Dumper does more aggressive cataloging of SCALARs encountered
+within ARRAY/HASH structures. Thanks to Norman Gaywood 
+<norm@godel.une.edu.au> for reporting the problem.
+
+Objects that C<overload> the '""' operator are now handled
+properly by the C<Dump> method.
+
+Significant additions to the testsuite.
+
+More documentation.
+
+=item 2.04beta  (28 August 1996)
+
+Made dump of glob names respect C<Useqq> setting.
+
+[@$%] are now escaped now when in double quotes.
+
+=item 2.03beta  (26 August 1996)
+
+Fixed Dumpxs.  It was appending trailing nulls to globnames.
+(reported by Randal Schwartz <merlyn@teleport.com>).
+
+Calling the C<Indent()> method on a dumper object now correctly
+resets the internal separator (reported by Curt Tilmes
+<curt@ltpmail.gsfc.nasa.gov>).
+
+New C<Terse> option to suppress the 'C<VARI<n> = >' prefix 
+introduced.  If the option is set, they are output only when
+absolutely essential.
+
+The C<Useqq> flag is supported (but not by the XSUB version
+yet).
+
+Embedded nulls in keys are now handled properly by Dumpxs.
+
+Dumper.xs now use various integer types in perl.h (should
+make it compile without noises on 64 bit platforms, although
+I haven't been able to test this).
+
+All the dump methods now return a list of strings in a list
+context.
+
+
+=item 2.02beta  (13 April 1996)
+
+Non portable sprintf usage in XS code fixed (thanks to 
+Ulrich Pfeifer <pfeifer@charly.informatik.uni-dortmund.de>).
+
+
+=item 2.01beta  (10 April 1996)
+
+Minor bugfix (single digit numbers were always getting quoted).
+
+
+=item 2.00beta  (9 April 1996)
+
+C<Dumpxs> is now the exact XSUB equivalent of C<Dump>.  The XS version
+is 4-5 times faster.
+
+C<require 5.002>.
+
+MLDBM example removed (as its own module, it has a separate CPAN 
+reality now).
+
+Fixed bugs in handling keys with wierd characters.  Perl can be
+tripped up in its implicit quoting of the word before '=>'.  The
+fix: C<Data::Dumper::Purity>, when set, always triggers quotes
+around hash keys.
+
+Andreas Koenig <k@anna.in-berlin.de> pointed out that handling octals
+is busted.  His patch added.
+
+Dead code removed, other minor documentation fixes.
+
+
+=item 1.23      (3 Dec 1995)
+
+MLDBM example added.
+
+Several folks pointed out that quoting of ticks and backslashes 
+in strings is missing. Added.
+
+Ian Phillips <ian@pipex.net> pointed out that numerics may lose 
+precision without quotes.  Fixed.
+
+
+=item 1.21     (20 Nov 1995)
+
+Last stable version I can remember.
+
+=back
+
+=cut
diff --git a/contrib/perl5/ext/Data/Dumper/Dumper.pm b/contrib/perl5/ext/Data/Dumper/Dumper.pm
new file mode 100644
index 0000000..e3c361f
--- /dev/null
+++ b/contrib/perl5/ext/Data/Dumper/Dumper.pm
@@ -0,0 +1,963 @@
+#
+# Data/Dumper.pm
+#
+# convert perl data structures into perl syntax suitable for both printing
+# and eval
+#
+# Documentation at the __END__
+#
+
+package Data::Dumper;
+
+$VERSION = $VERSION = '2.09';
+
+#$| = 1;
+
+require 5.004;
+require Exporter;
+require DynaLoader;
+require overload;
+
+use Carp;
+
+@ISA = qw(Exporter DynaLoader);
+@EXPORT = qw(Dumper);
+@EXPORT_OK = qw(DumperX);
+
+bootstrap Data::Dumper;
+
+# module vars and their defaults
+$Indent = 2 unless defined $Indent;
+$Purity = 0 unless defined $Purity;
+$Pad = "" unless defined $Pad;
+$Varname = "VAR" unless defined $Varname;
+$Useqq = 0 unless defined $Useqq;
+$Terse = 0 unless defined $Terse;
+$Freezer = "" unless defined $Freezer;
+$Toaster = "" unless defined $Toaster;
+$Deepcopy = 0 unless defined $Deepcopy;
+$Quotekeys = 1 unless defined $Quotekeys;
+$Bless = "bless" unless defined $Bless;
+#$Expdepth = 0 unless defined $Expdepth;
+#$Maxdepth = 0 unless defined $Maxdepth;
+
+#
+# expects an arrayref of values to be dumped.
+# can optionally pass an arrayref of names for the values.
+# names must have leading $ sign stripped. begin the name with *
+# to cause output of arrays and hashes rather than refs.
+#
+sub new {
+  my($c, $v, $n) = @_;
+
+  croak "Usage:  PACKAGE->new(ARRAYREF, [ARRAYREF])" 
+    unless (defined($v) && (ref($v) eq 'ARRAY'));
+  $n = [] unless (defined($n) && (ref($v) eq 'ARRAY'));
+
+  my($s) = { 
+             level      => 0,           # current recursive depth
+	     indent     => $Indent,     # various styles of indenting
+	     pad	=> $Pad,        # all lines prefixed by this string
+	     xpad       => "",          # padding-per-level
+	     apad       => "",          # added padding for hash keys n such
+	     sep        => "",          # list separator
+	     seen       => {},          # local (nested) refs (id => [name, val])
+	     todump     => $v,          # values to dump []
+	     names      => $n,          # optional names for values []
+	     varname    => $Varname,    # prefix to use for tagging nameless ones
+             purity     => $Purity,     # degree to which output is evalable
+             useqq 	=> $Useqq,      # use "" for strings (backslashitis ensues)
+             terse 	=> $Terse,      # avoid name output (where feasible)
+             freezer	=> $Freezer,    # name of Freezer method for objects
+             toaster	=> $Toaster,    # name of method to revive objects
+             deepcopy	=> $Deepcopy,   # dont cross-ref, except to stop recursion
+             quotekeys	=> $Quotekeys,  # quote hash keys
+             'bless'	=> $Bless,	# keyword to use for "bless"
+#	     expdepth   => $Expdepth,   # cutoff depth for explicit dumping
+#	     maxdepth	=> $Maxdepth,   # depth beyond which we give up
+	   };
+
+  if ($Indent > 0) {
+    $s->{xpad} = "  ";
+    $s->{sep} = "\n";
+  }
+  return bless($s, $c);
+}
+
+#
+# add-to or query the table of already seen references
+#
+sub Seen {
+  my($s, $g) = @_;
+  if (defined($g) && (ref($g) eq 'HASH'))  {
+    my($k, $v, $id);
+    while (($k, $v) = each %$g) {
+      if (defined $v and ref $v) {
+	($id) = (overload::StrVal($v) =~ /\((.*)\)$/);
+	if ($k =~ /^[*](.*)$/) {
+	  $k = (ref $v eq 'ARRAY') ? ( "\\\@" . $1 ) :
+	       (ref $v eq 'HASH')  ? ( "\\\%" . $1 ) :
+	       (ref $v eq 'CODE')  ? ( "\\\&" . $1 ) :
+				     (   "\$" . $1 ) ;
+	}
+	elsif ($k !~ /^\$/) {
+	  $k = "\$" . $k;
+	}
+	$s->{seen}{$id} = [$k, $v];
+      }
+      else {
+	carp "Only refs supported, ignoring non-ref item \$$k";
+      }
+    }
+    return $s;
+  }
+  else {
+    return map { @$_ } values %{$s->{seen}};
+  }
+}
+
+#
+# set or query the values to be dumped
+#
+sub Values {
+  my($s, $v) = @_;
+  if (defined($v) && (ref($v) eq 'ARRAY'))  {
+    $s->{todump} = [@$v];        # make a copy
+    return $s;
+  }
+  else {
+    return @{$s->{todump}};
+  }
+}
+
+#
+# set or query the names of the values to be dumped
+#
+sub Names {
+  my($s, $n) = @_;
+  if (defined($n) && (ref($n) eq 'ARRAY'))  {
+    $s->{names} = [@$n];         # make a copy
+    return $s;
+  }
+  else {
+    return @{$s->{names}};
+  }
+}
+
+sub DESTROY {}
+
+#
+# dump the refs in the current dumper object.
+# expects same args as new() if called via package name.
+#
+sub Dump {
+  my($s) = shift;
+  my(@out, $val, $name);
+  my($i) = 0;
+  local(@post);
+
+  $s = $s->new(@_) unless ref $s;
+
+  for $val (@{$s->{todump}}) {
+    my $out = "";
+    @post = ();
+    $name = $s->{names}[$i++];
+    if (defined $name) {
+      if ($name =~ /^[*](.*)$/) {
+	if (defined $val) {
+	  $name = (ref $val eq 'ARRAY') ? ( "\@" . $1 ) :
+		  (ref $val eq 'HASH')  ? ( "\%" . $1 ) :
+		  (ref $val eq 'CODE')  ? ( "\*" . $1 ) :
+					  ( "\$" . $1 ) ;
+	}
+	else {
+	  $name = "\$" . $1;
+	}
+      }
+      elsif ($name !~ /^\$/) {
+	$name = "\$" . $name;
+      }
+    }
+    else {
+      $name = "\$" . $s->{varname} . $i;
+    }
+
+    my $valstr;
+    {
+      local($s->{apad}) = $s->{apad};
+      $s->{apad} .= ' ' x (length($name) + 3) if $s->{indent} >= 2;
+      $valstr = $s->_dump($val, $name);
+    }
+
+    $valstr = "$name = " . $valstr . ';' if @post or !$s->{terse};
+    $out .= $s->{pad} . $valstr . $s->{sep};
+    $out .= $s->{pad} . join(';' . $s->{sep} . $s->{pad}, @post) 
+      . ';' . $s->{sep} if @post;
+
+    push @out, $out;
+  }
+  return wantarray ? @out : join('', @out);
+}
+
+#
+# twist, toil and turn;
+# and recurse, of course.
+#
+sub _dump {
+  my($s, $val, $name) = @_;
+  my($sname);
+  my($out, $realpack, $realtype, $type, $ipad, $id, $blesspad);
+
+  return "undef" unless defined $val;
+
+  $type = ref $val;
+  $out = "";
+
+  if ($type) {
+
+    # prep it, if it looks like an object
+    if ($type =~ /[a-z_:]/) {
+      my $freezer = $s->{freezer};
+      # UNIVERSAL::can should be used here, when we can require 5.004
+      if ($freezer) {
+	eval { $val->$freezer() };
+	carp "WARNING(Freezer method call failed): $@" if $@;
+      }
+    }
+
+    ($realpack, $realtype, $id) =
+      (overload::StrVal($val) =~ /^(?:(.*)\=)?([^=]*)\(([^\(]*)\)$/);
+    
+    # keep a tab on it so that we dont fall into recursive pit
+    if (exists $s->{seen}{$id}) {
+#     if ($s->{expdepth} < $s->{level}) {
+      if ($s->{purity} and $s->{level} > 0) {
+	$out = ($realtype eq 'HASH')  ? '{}' :
+	       ($realtype eq 'ARRAY') ? '[]' :
+					"''" ;
+	  push @post, $name . " = " . $s->{seen}{$id}[0];
+      }
+      else {
+	$out = $s->{seen}{$id}[0];
+	if ($name =~ /^([\@\%])/) {
+	  my $start = $1;
+	  if ($out =~ /^\\$start/) {
+	    $out = substr($out, 1);
+	  }
+	  else {
+	    $out = $start . '{' . $out . '}';
+	  }
+	}
+      }
+      return $out;
+#     }
+    }
+    else {
+      # store our name
+      $s->{seen}{$id} = [ (($name =~ /^[@%]/)     ? ('\\' . $name ) :
+			   ($realtype eq 'CODE' and
+			    $name =~ /^[*](.*)$/) ? ('\\&' . $1 )   :
+						     $name          ),
+			  $val ];
+    }
+
+    $s->{level}++;
+    $ipad = $s->{xpad} x $s->{level};
+
+    if ($realpack) {          # we have a blessed ref
+      $out = $s->{'bless'} . '( ';
+      $blesspad = $s->{apad};
+      $s->{apad} .= '       ' if ($s->{indent} >= 2);
+    }
+    
+    if ($realtype eq 'SCALAR') {
+      if ($realpack) {
+	$out .= 'do{\\(my $o = ' . $s->_dump($$val, "") . ')}';
+      }
+      else {
+	$out .= '\\' . $s->_dump($$val, "");
+      }
+    }
+    elsif ($realtype eq 'GLOB') {
+	$out .= '\\' . $s->_dump($$val, "");
+    }
+    elsif ($realtype eq 'ARRAY') {
+      my($v, $pad, $mname);
+      my($i) = 0;
+      $out .= ($name =~ /^\@/) ? '(' : '[';
+      $pad = $s->{sep} . $s->{pad} . $s->{apad};
+      ($name =~ /^\@(.*)$/) ? ($mname = "\$" . $1) : 
+	($name =~ /[]}]$/) ? ($mname = $name) : ($mname = $name . '->');
+      $mname .= '->' if $mname =~ /^\*.+\{[A-Z]+\}$/;
+      for $v (@$val) {
+	$sname = $mname . '[' . $i . ']';
+	$out .= $pad . $ipad . '#' . $i if $s->{indent} >= 3;
+	$out .= $pad . $ipad . $s->_dump($v, $sname);
+	$out .= "," if $i++ < $#$val;
+      }
+      $out .= $pad . ($s->{xpad} x ($s->{level} - 1)) if $i;
+      $out .= ($name =~ /^\@/) ? ')' : ']';
+    }
+    elsif ($realtype eq 'HASH') {
+      my($k, $v, $pad, $lpad, $mname);
+      $out .= ($name =~ /^\%/) ? '(' : '{';
+      $pad = $s->{sep} . $s->{pad} . $s->{apad};
+      $lpad = $s->{apad};
+      ($name =~ /^\%(.*)$/) ? ($mname = "\$" . $1) : 
+	($name =~ /[]}]$/) ? ($mname = $name) : ($mname = $name . '->');
+      $mname .= '->' if $mname =~ /^\*.+\{[A-Z]+\}$/;
+      while (($k, $v) = each %$val) {
+	my $nk = $s->_dump($k, "");
+	$nk = $1 if !$s->{quotekeys} and $nk =~ /^[\"\']([A-Za-z_]\w*)[\"\']$/;
+	$sname = $mname . '{' . $nk . '}';
+	$out .= $pad . $ipad . $nk . " => ";
+
+	# temporarily alter apad
+	$s->{apad} .= (" " x (length($nk) + 4)) if $s->{indent} >= 2;
+	$out .= $s->_dump($val->{$k}, $sname) . ",";
+	$s->{apad} = $lpad if $s->{indent} >= 2;
+      }
+      if (substr($out, -1) eq ',') {
+	chop $out;
+	$out .= $pad . ($s->{xpad} x ($s->{level} - 1));
+      }
+      $out .= ($name =~ /^\%/) ? ')' : '}';
+    }
+    elsif ($realtype eq 'CODE') {
+      $out .= '"DUMMY"';
+      $out = 'sub { ' . $out . ' }';
+      carp "Encountered CODE ref, using dummy placeholder" if $s->{purity};
+    }
+    else {
+      croak "Can\'t handle $realtype type.";
+    }
+    
+    if ($realpack) { # we have a blessed ref
+      $out .= ', \'' . $realpack . '\'' . ' )';
+      $out .= '->' . $s->{toaster} . '()'  if $s->{toaster} ne '';
+      $s->{apad} = $blesspad;
+    }
+    $s->{level}--;
+
+  }
+  else {                                 # simple scalar
+
+    my $ref = \$_[1];
+    # first, catalog the scalar
+    if ($name ne '') {
+      ($id) = ("$ref" =~ /\(([^\(]*)\)$/);
+      if (exists $s->{seen}{$id}) {
+	$out = $s->{seen}{$id}[0];
+	return $out;
+      }
+      else {
+	$s->{seen}{$id} = ["\\$name", $val];
+      }
+    }
+    if (ref($ref) eq 'GLOB' or "$ref" =~ /=GLOB\([^()]+\)$/) {  # glob
+      my $name = substr($val, 1);
+      if ($name =~ /^[A-Za-z_][\w:]*$/) {
+	$name =~ s/^main::/::/;
+	$sname = $name;
+      }
+      else {
+	$sname = $s->_dump($name, "");
+	$sname = '{' . $sname . '}';
+      }
+      if ($s->{purity}) {
+	my $k;
+	local ($s->{level}) = 0;
+	for $k (qw(SCALAR ARRAY HASH)) {
+	  # _dump can push into @post, so we hold our place using $postlen
+	  my $postlen = scalar @post;
+	  $post[$postlen] = "\*$sname = ";
+	  local ($s->{apad}) = " " x length($post[$postlen]) if $s->{indent} >= 2;
+	  $post[$postlen] .= $s->_dump(*{$name}{$k}, "\*$sname\{$k\}");
+	}
+      }
+      $out .= '*' . $sname;
+    }
+    elsif ($val =~ /^-?[1-9]\d{0,8}$/) { # safe decimal number
+      $out .= $val;
+    }
+    else {				 # string
+      if ($s->{useqq}) {
+	$out .= qquote($val);
+      }
+      else {
+	$val =~ s/([\\\'])/\\$1/g;
+	$out .= '\'' . $val .  '\'';
+      }
+    }
+  }
+
+  # if we made it this far, $id was added to seen list at current
+  # level, so remove it to get deep copies
+  delete($s->{seen}{$id}) if $id and $s->{deepcopy};
+  return $out;
+}
+  
+#
+# non-OO style of earlier version
+#
+sub Dumper {
+  return Data::Dumper->Dump([@_]);
+}
+
+#
+# same, only calls the XS version
+#
+sub DumperX {
+  return Data::Dumper->Dumpxs([@_], []);
+}
+
+sub Dumpf { return Data::Dumper->Dump(@_) }
+
+sub Dumpp { print Data::Dumper->Dump(@_) }
+
+#
+# reset the "seen" cache 
+#
+sub Reset {
+  my($s) = shift;
+  $s->{seen} = {};
+  return $s;
+}
+
+sub Indent {
+  my($s, $v) = @_;
+  if (defined($v)) {
+    if ($v == 0) {
+      $s->{xpad} = "";
+      $s->{sep} = "";
+    }
+    else {
+      $s->{xpad} = "  ";
+      $s->{sep} = "\n";
+    }
+    $s->{indent} = $v;
+    return $s;
+  }
+  else {
+    return $s->{indent};
+  }
+}
+
+sub Pad {
+  my($s, $v) = @_;
+  defined($v) ? (($s->{pad} = $v), return $s) : $s->{pad};
+}
+
+sub Varname {
+  my($s, $v) = @_;
+  defined($v) ? (($s->{varname} = $v), return $s) : $s->{varname};
+}
+
+sub Purity {
+  my($s, $v) = @_;
+  defined($v) ? (($s->{purity} = $v), return $s) : $s->{purity};
+}
+
+sub Useqq {
+  my($s, $v) = @_;
+  defined($v) ? (($s->{useqq} = $v), return $s) : $s->{useqq};
+}
+
+sub Terse {
+  my($s, $v) = @_;
+  defined($v) ? (($s->{terse} = $v), return $s) : $s->{terse};
+}
+
+sub Freezer {
+  my($s, $v) = @_;
+  defined($v) ? (($s->{freezer} = $v), return $s) : $s->{freezer};
+}
+
+sub Toaster {
+  my($s, $v) = @_;
+  defined($v) ? (($s->{toaster} = $v), return $s) : $s->{toaster};
+}
+
+sub Deepcopy {
+  my($s, $v) = @_;
+  defined($v) ? (($s->{deepcopy} = $v), return $s) : $s->{deepcopy};
+}
+
+sub Quotekeys {
+  my($s, $v) = @_;
+  defined($v) ? (($s->{quotekeys} = $v), return $s) : $s->{quotekeys};
+}
+
+sub Bless {
+  my($s, $v) = @_;
+  defined($v) ? (($s->{'bless'} = $v), return $s) : $s->{'bless'};
+}
+
+# put a string value in double quotes
+sub qquote {
+  local($_) = shift;
+  s/([\\\"\@\$\%])/\\$1/g;    
+  s/\a/\\a/g;
+  s/[\b]/\\b/g;
+  s/\t/\\t/g;
+  s/\n/\\n/g;
+  s/\f/\\f/g;
+  s/\r/\\r/g;
+  s/\e/\\e/g;
+
+# this won't work!
+#  s/([^\a\b\t\n\f\r\e\038-\176])/'\\'.sprintf('%03o',ord($1))/eg;
+  s/([\000-\006\013\016-\032\034-\037\177\200-\377])/'\\'.sprintf('%03o',ord($1))/eg;
+  return "\"$_\"";
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Data::Dumper - stringified perl data structures, suitable for both printing and C<eval>
+
+
+=head1 SYNOPSIS
+
+    use Data::Dumper;
+
+    # simple procedural interface
+    print Dumper($foo, $bar);
+
+    # extended usage with names
+    print Data::Dumper->Dump([$foo, $bar], [qw(foo *ary)]);
+
+    # configuration variables
+    {
+      local $Data::Dump::Purity = 1;
+      eval Data::Dumper->Dump([$foo, $bar], [qw(foo *ary)]);
+    }
+
+    # OO usage
+    $d = Data::Dumper->new([$foo, $bar], [qw(foo *ary)]);
+       ...
+    print $d->Dump;
+       ...
+    $d->Purity(1)->Terse(1)->Deepcopy(1);
+    eval $d->Dump;
+
+
+=head1 DESCRIPTION
+
+Given a list of scalars or reference variables, writes out their contents in
+perl syntax. The references can also be objects.  The contents of each
+variable is output in a single Perl statement.  Handles self-referential
+structures correctly.
+
+The return value can be C<eval>ed to get back an identical copy of the
+original reference structure.
+
+Any references that are the same as one of those passed in will be named
+C<$VAR>I<n> (where I<n> is a numeric suffix), and other duplicate references
+to substructures within C<$VAR>I<n> will be appropriately labeled using arrow
+notation.  You can specify names for individual values to be dumped if you
+use the C<Dump()> method, or you can change the default C<$VAR> prefix to
+something else.  See C<$Data::Dumper::Varname> and C<$Data::Dumper::Terse>
+below.
+
+The default output of self-referential structures can be C<eval>ed, but the
+nested references to C<$VAR>I<n> will be undefined, since a recursive
+structure cannot be constructed using one Perl statement.  You should set the
+C<Purity> flag to 1 to get additional statements that will correctly fill in
+these references.
+
+In the extended usage form, the references to be dumped can be given
+user-specified names.  If a name begins with a C<*>, the output will 
+describe the dereferenced type of the supplied reference for hashes and
+arrays, and coderefs.  Output of names will be avoided where possible if
+the C<Terse> flag is set.
+
+In many cases, methods that are used to set the internal state of the
+object will return the object itself, so method calls can be conveniently
+chained together.
+
+Several styles of output are possible, all controlled by setting
+the C<Indent> flag.  See L<Configuration Variables or Methods> below 
+for details.
+
+
+=head2 Methods
+
+=over 4
+
+=item I<PACKAGE>->new(I<ARRAYREF [>, I<ARRAYREF]>)
+
+Returns a newly created C<Data::Dumper> object.  The first argument is an
+anonymous array of values to be dumped.  The optional second argument is an
+anonymous array of names for the values.  The names need not have a leading
+C<$> sign, and must be comprised of alphanumeric characters.  You can begin
+a name with a C<*> to specify that the dereferenced type must be dumped
+instead of the reference itself, for ARRAY and HASH references.
+
+The prefix specified by C<$Data::Dumper::Varname> will be used with a
+numeric suffix if the name for a value is undefined.
+
+Data::Dumper will catalog all references encountered while dumping the
+values. Cross-references (in the form of names of substructures in perl
+syntax) will be inserted at all possible points, preserving any structural
+interdependencies in the original set of values.  Structure traversal is
+depth-first,  and proceeds in order from the first supplied value to
+the last.
+
+=item I<$OBJ>->Dump  I<or>  I<PACKAGE>->Dump(I<ARRAYREF [>, I<ARRAYREF]>)
+
+Returns the stringified form of the values stored in the object (preserving
+the order in which they were supplied to C<new>), subject to the
+configuration options below.  In an array context, it returns a list
+of strings corresponding to the supplied values.
+
+The second form, for convenience, simply calls the C<new> method on its
+arguments before dumping the object immediately.
+
+=item I<$OBJ>->Dumpxs  I<or>  I<PACKAGE>->Dumpxs(I<ARRAYREF [>, I<ARRAYREF]>)
+
+This method is available if you were able to compile and install the XSUB
+extension to C<Data::Dumper>. It is exactly identical to the C<Dump> method 
+above, only about 4 to 5 times faster, since it is written entirely in C.
+
+=item I<$OBJ>->Seen(I<[HASHREF]>)
+
+Queries or adds to the internal table of already encountered references.
+You must use C<Reset> to explicitly clear the table if needed.  Such
+references are not dumped; instead, their names are inserted wherever they
+are encountered subsequently.  This is useful especially for properly
+dumping subroutine references.
+
+Expects a anonymous hash of name => value pairs.  Same rules apply for names
+as in C<new>.  If no argument is supplied, will return the "seen" list of
+name => value pairs, in an array context.  Otherwise, returns the object
+itself.
+
+=item I<$OBJ>->Values(I<[ARRAYREF]>)
+
+Queries or replaces the internal array of values that will be dumped.
+When called without arguments, returns the values.  Otherwise, returns the
+object itself.
+
+=item I<$OBJ>->Names(I<[ARRAYREF]>)
+
+Queries or replaces the internal array of user supplied names for the values
+that will be dumped.  When called without arguments, returns the names.
+Otherwise, returns the object itself.
+
+=item I<$OBJ>->Reset
+
+Clears the internal table of "seen" references and returns the object
+itself.
+
+=back
+
+=head2 Functions
+
+=over 4
+
+=item Dumper(I<LIST>)
+
+Returns the stringified form of the values in the list, subject to the
+configuration options below.  The values will be named C<$VAR>I<n> in the
+output, where I<n> is a numeric suffix.  Will return a list of strings
+in an array context.
+
+=item DumperX(I<LIST>)
+
+Identical to the C<Dumper()> function above, but this calls the XSUB 
+implementation.  Only available if you were able to compile and install
+the XSUB extensions in C<Data::Dumper>.
+
+=back
+
+=head2 Configuration Variables or Methods
+
+Several configuration variables can be used to control the kind of output
+generated when using the procedural interface.  These variables are usually
+C<local>ized in a block so that other parts of the code are not affected by
+the change.  
+
+These variables determine the default state of the object created by calling
+the C<new> method, but cannot be used to alter the state of the object
+thereafter.  The equivalent method names should be used instead to query
+or set the internal state of the object.
+
+The method forms return the object itself when called with arguments,
+so that they can be chained together nicely.
+
+=over 4
+
+=item $Data::Dumper::Indent  I<or>  I<$OBJ>->Indent(I<[NEWVAL]>)
+
+Controls the style of indentation.  It can be set to 0, 1, 2 or 3.  Style 0
+spews output without any newlines, indentation, or spaces between list
+items.  It is the most compact format possible that can still be called
+valid perl.  Style 1 outputs a readable form with newlines but no fancy
+indentation (each level in the structure is simply indented by a fixed
+amount of whitespace).  Style 2 (the default) outputs a very readable form
+which takes into account the length of hash keys (so the hash value lines
+up).  Style 3 is like style 2, but also annotates the elements of arrays
+with their index (but the comment is on its own line, so array output
+consumes twice the number of lines).  Style 2 is the default.
+
+=item $Data::Dumper::Purity  I<or>  I<$OBJ>->Purity(I<[NEWVAL]>)
+
+Controls the degree to which the output can be C<eval>ed to recreate the
+supplied reference structures.  Setting it to 1 will output additional perl
+statements that will correctly recreate nested references.  The default is
+0.
+
+=item $Data::Dumper::Pad  I<or>  I<$OBJ>->Pad(I<[NEWVAL]>)
+
+Specifies the string that will be prefixed to every line of the output.
+Empty string by default.
+
+=item $Data::Dumper::Varname  I<or>  I<$OBJ>->Varname(I<[NEWVAL]>)
+
+Contains the prefix to use for tagging variable names in the output. The
+default is "VAR".
+
+=item $Data::Dumper::Useqq  I<or>  I<$OBJ>->Useqq(I<[NEWVAL]>)
+
+When set, enables the use of double quotes for representing string values.
+Whitespace other than space will be represented as C<[\n\t\r]>, "unsafe"
+characters will be backslashed, and unprintable characters will be output as
+quoted octal integers.  Since setting this variable imposes a performance
+penalty, the default is 0.  The C<Dumpxs()> method does not honor this
+flag yet.
+
+=item $Data::Dumper::Terse  I<or>  I<$OBJ>->Terse(I<[NEWVAL]>)
+
+When set, Data::Dumper will emit single, non-self-referential values as
+atoms/terms rather than statements.  This means that the C<$VAR>I<n> names
+will be avoided where possible, but be advised that such output may not
+always be parseable by C<eval>.
+
+=item $Data::Dumper::Freezer  I<or>  $I<OBJ>->Freezer(I<[NEWVAL]>)
+
+Can be set to a method name, or to an empty string to disable the feature.
+Data::Dumper will invoke that method via the object before attempting to
+stringify it.  This method can alter the contents of the object (if, for
+instance, it contains data allocated from C), and even rebless it in a
+different package.  The client is responsible for making sure the specified
+method can be called via the object, and that the object ends up containing
+only perl data types after the method has been called.  Defaults to an empty
+string.
+
+=item $Data::Dumper::Toaster  I<or>  $I<OBJ>->Toaster(I<[NEWVAL]>)
+
+Can be set to a method name, or to an empty string to disable the feature.
+Data::Dumper will emit a method call for any objects that are to be dumped
+using the syntax C<bless(DATA, CLASS)->METHOD()>.  Note that this means that
+the method specified will have to perform any modifications required on the
+object (like creating new state within it, and/or reblessing it in a
+different package) and then return it.  The client is responsible for making
+sure the method can be called via the object, and that it returns a valid
+object.  Defaults to an empty string.
+
+=item $Data::Dumper::Deepcopy  I<or>  $I<OBJ>->Deepcopy(I<[NEWVAL]>)
+
+Can be set to a boolean value to enable deep copies of structures.
+Cross-referencing will then only be done when absolutely essential
+(i.e., to break reference cycles).  Default is 0.
+
+=item $Data::Dumper::Quotekeys  I<or>  $I<OBJ>->Quotekeys(I<[NEWVAL]>)
+
+Can be set to a boolean value to control whether hash keys are quoted.
+A false value will avoid quoting hash keys when it looks like a simple
+string.  Default is 1, which will always enclose hash keys in quotes.
+
+=item $Data::Dumper::Bless  I<or>  $I<OBJ>->Bless(I<[NEWVAL]>)
+
+Can be set to a string that specifies an alternative to the C<bless>
+builtin operator used to create objects.  A function with the specified
+name should exist, and should accept the same arguments as the builtin.
+Default is C<bless>.
+
+=back
+
+=head2 Exports
+
+=over 4
+
+=item Dumper
+
+=back
+
+=head1 EXAMPLES
+
+Run these code snippets to get a quick feel for the behavior of this
+module.  When you are through with these examples, you may want to
+add or change the various configuration variables described above,
+to see their behavior.  (See the testsuite in the Data::Dumper
+distribution for more examples.)
+
+
+    use Data::Dumper;
+
+    package Foo;
+    sub new {bless {'a' => 1, 'b' => sub { return "foo" }}, $_[0]};
+
+    package Fuz;                       # a weird REF-REF-SCALAR object
+    sub new {bless \($_ = \ 'fu\'z'), $_[0]};
+
+    package main;
+    $foo = Foo->new;
+    $fuz = Fuz->new;
+    $boo = [ 1, [], "abcd", \*foo,
+             {1 => 'a', 023 => 'b', 0x45 => 'c'}, 
+             \\"p\q\'r", $foo, $fuz];
+    
+    ########
+    # simple usage
+    ########
+
+    $bar = eval(Dumper($boo));
+    print($@) if $@;
+    print Dumper($boo), Dumper($bar);  # pretty print (no array indices)
+
+    $Data::Dumper::Terse = 1;          # don't output names where feasible
+    $Data::Dumper::Indent = 0;         # turn off all pretty print
+    print Dumper($boo), "\n";
+
+    $Data::Dumper::Indent = 1;         # mild pretty print
+    print Dumper($boo);
+
+    $Data::Dumper::Indent = 3;         # pretty print with array indices
+    print Dumper($boo);
+
+    $Data::Dumper::Useqq = 1;          # print strings in double quotes
+    print Dumper($boo);
+    
+    
+    ########
+    # recursive structures
+    ########
+    
+    @c = ('c');
+    $c = \@c;
+    $b = {};
+    $a = [1, $b, $c];
+    $b->{a} = $a;
+    $b->{b} = $a->[1];
+    $b->{c} = $a->[2];
+    print Data::Dumper->Dump([$a,$b,$c], [qw(a b c)]);
+    
+    
+    $Data::Dumper::Purity = 1;         # fill in the holes for eval
+    print Data::Dumper->Dump([$a, $b], [qw(*a b)]); # print as @a
+    print Data::Dumper->Dump([$b, $a], [qw(*b a)]); # print as %b
+    
+    
+    $Data::Dumper::Deepcopy = 1;       # avoid cross-refs
+    print Data::Dumper->Dump([$b, $a], [qw(*b a)]);
+    
+    
+    $Data::Dumper::Purity = 0;         # avoid cross-refs
+    print Data::Dumper->Dump([$b, $a], [qw(*b a)]);
+    
+    
+    ########
+    # object-oriented usage
+    ########
+    
+    $d = Data::Dumper->new([$a,$b], [qw(a b)]);
+    $d->Seen({'*c' => $c});            # stash a ref without printing it
+    $d->Indent(3);
+    print $d->Dump;
+    $d->Reset->Purity(0);              # empty the seen cache
+    print join "----\n", $d->Dump;
+    
+    
+    ########
+    # persistence
+    ########
+    
+    package Foo;
+    sub new { bless { state => 'awake' }, shift }
+    sub Freeze {
+        my $s = shift;
+	print STDERR "preparing to sleep\n";
+	$s->{state} = 'asleep';
+	return bless $s, 'Foo::ZZZ';
+    }
+    
+    package Foo::ZZZ;
+    sub Thaw {
+        my $s = shift;
+	print STDERR "waking up\n";
+	$s->{state} = 'awake';
+	return bless $s, 'Foo';
+    }
+    
+    package Foo;
+    use Data::Dumper;
+    $a = Foo->new;
+    $b = Data::Dumper->new([$a], ['c']);
+    $b->Freezer('Freeze');
+    $b->Toaster('Thaw');
+    $c = $b->Dump;
+    print $c;
+    $d = eval $c;
+    print Data::Dumper->Dump([$d], ['d']);
+    
+    
+    ########
+    # symbol substitution (useful for recreating CODE refs)
+    ########
+    
+    sub foo { print "foo speaking\n" }
+    *other = \&foo;
+    $bar = [ \&other ];
+    $d = Data::Dumper->new([\&other,$bar],['*other','bar']);
+    $d->Seen({ '*foo' => \&foo });
+    print $d->Dump;
+
+
+=head1 BUGS
+
+Due to limitations of Perl subroutine call semantics, you cannot pass an
+array or hash.  Prepend it with a C<\> to pass its reference instead.  This
+will be remedied in time, with the arrival of prototypes in later versions
+of Perl.  For now, you need to use the extended usage form, and prepend the
+name with a C<*> to output it as a hash or array.
+
+C<Data::Dumper> cheats with CODE references.  If a code reference is
+encountered in the structure being processed, an anonymous subroutine that
+contains the string '"DUMMY"' will be inserted in its place, and a warning
+will be printed if C<Purity> is set.  You can C<eval> the result, but bear
+in mind that the anonymous sub that gets created is just a placeholder.
+Someday, perl will have a switch to cache-on-demand the string
+representation of a compiled piece of code, I hope.  If you have prior
+knowledge of all the code refs that your data structures are likely
+to have, you can use the C<Seen> method to pre-seed the internal reference
+table and make the dumped output point to them, instead.  See L<EXAMPLES>
+above.
+
+The C<Useqq> flag is not honored by C<Dumpxs()> (it always outputs
+strings in single quotes).
+
+SCALAR objects have the weirdest looking C<bless> workaround.
+
+
+=head1 AUTHOR
+
+Gurusamy Sarathy        gsar@umich.edu
+
+Copyright (c) 1996-98 Gurusamy Sarathy. All rights reserved.
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+
+=head1 VERSION
+
+Version 2.09    (9 July 1998)
+
+=head1 SEE ALSO
+
+perl(1)
+
+=cut
diff --git a/contrib/perl5/ext/Data/Dumper/Dumper.xs b/contrib/perl5/ext/Data/Dumper/Dumper.xs
new file mode 100644
index 0000000..d8012ee
--- /dev/null
+++ b/contrib/perl5/ext/Data/Dumper/Dumper.xs
@@ -0,0 +1,800 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+static SV	*freezer;
+static SV	*toaster;
+
+static I32 num_q _((char *s, STRLEN slen));
+static I32 esc_q _((char *dest, char *src, STRLEN slen));
+static SV *sv_x _((SV *sv, char *str, STRLEN len, I32 n));
+static I32 DD_dump _((SV *val, char *name, STRLEN namelen, SV *retval,
+		      HV *seenhv, AV *postav, I32 *levelp, I32 indent,
+		      SV *pad, SV *xpad, SV *apad, SV *sep,
+		      SV *freezer, SV *toaster,
+		      I32 purity, I32 deepcopy, I32 quotekeys, SV *bless));
+
+/* does a string need to be protected? */
+static I32
+needs_quote(register char *s)
+{
+TOP:
+    if (s[0] == ':') {
+	if (*++s) {
+	    if (*s++ != ':')
+		return 1;
+	}
+	else
+	    return 1;
+    }
+    if (isIDFIRST(*s)) {
+	while (*++s)
+	    if (!isALNUM(*s))
+		if (*s == ':')
+		    goto TOP;
+		else
+		    return 1;
+    }
+    else 
+	return 1;
+    return 0;
+}
+
+/* count the number of "'"s and "\"s in string */
+static I32
+num_q(register char *s, register STRLEN slen)
+{
+    register I32 ret = 0;
+
+    while (slen > 0) {
+	if (*s == '\'' || *s == '\\')
+	    ++ret;
+	++s;
+	--slen;
+    }
+    return ret;
+}
+
+
+/* returns number of chars added to escape "'"s and "\"s in s */
+/* slen number of characters in s will be escaped */
+/* destination must be long enough for additional chars */
+static I32
+esc_q(register char *d, register char *s, register STRLEN slen)
+{
+    register I32 ret = 0;
+    
+    while (slen > 0) {
+	switch (*s) {
+	case '\'':
+	case '\\':
+	    *d = '\\';
+	    ++d; ++ret;
+	default:
+	    *d = *s;
+	    ++d; ++s; --slen;
+	    break;
+	}
+    }
+    return ret;
+}
+
+/* append a repeated string to an SV */
+static SV *
+sv_x(SV *sv, register char *str, STRLEN len, I32 n)
+{
+    if (sv == Nullsv)
+	sv = newSVpv("", 0);
+    else
+	assert(SvTYPE(sv) >= SVt_PV);
+
+    if (n > 0) {
+	SvGROW(sv, len*n + SvCUR(sv) + 1);
+	if (len == 1) {
+	    char *start = SvPVX(sv) + SvCUR(sv);
+	    SvCUR(sv) += n;
+	    start[n] = '\0';
+	    while (n > 0)
+		start[--n] = str[0];
+	}
+	else
+	    while (n > 0) {
+		sv_catpvn(sv, str, len);
+		--n;
+	    }
+    }
+    return sv;
+}
+
+/*
+ * This ought to be split into smaller functions. (it is one long function since
+ * it exactly parallels the perl version, which was one long thing for
+ * efficiency raisins.)  Ugggh!
+ */
+static I32
+DD_dump(SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv,
+	AV *postav, I32 *levelp, I32 indent, SV *pad, SV *xpad,
+	SV *apad, SV *sep, SV *freezer, SV *toaster, I32 purity,
+	I32 deepcopy, I32 quotekeys, SV *bless)
+{
+    char tmpbuf[128];
+    U32 i;
+    char *c, *r, *realpack, id[128];
+    SV **svp;
+    SV *sv;
+    SV *blesspad = Nullsv;
+    SV *ipad;
+    SV *ival;
+    AV *seenentry;
+    char *iname;
+    STRLEN inamelen, idlen = 0;
+    U32 flags;
+    U32 realtype;
+
+    if (!val)
+	return 0;
+
+    flags = SvFLAGS(val);
+    realtype = SvTYPE(val);
+    
+    if (SvGMAGICAL(val))
+        mg_get(val);
+    if (val == &PL_sv_undef || !SvOK(val)) {
+	sv_catpvn(retval, "undef", 5);
+	return 1;
+    }
+    if (SvROK(val)) {
+
+	if (SvOBJECT(SvRV(val)) && freezer &&
+	    SvPOK(freezer) && SvCUR(freezer))
+	{
+	    dSP; ENTER; SAVETMPS; PUSHMARK(sp);
+	    XPUSHs(val); PUTBACK;
+	    i = perl_call_method(SvPVX(freezer), G_EVAL|G_SCALAR);
+	    SPAGAIN;
+	    if (SvTRUE(GvSV(PL_errgv)))
+		warn("WARNING(Freezer method call failed): %s",
+		     SvPVX(GvSV(PL_errgv)));
+	    else if (i)
+		val = newSVsv(POPs);
+	    PUTBACK; FREETMPS; LEAVE;
+	    if (i)
+		(void)sv_2mortal(val);
+	}
+	
+	ival = SvRV(val);
+	flags = SvFLAGS(ival);
+	realtype = SvTYPE(ival);
+        (void) sprintf(id, "0x%lx", (unsigned long)ival);
+	idlen = strlen(id);
+	if (SvOBJECT(ival))
+	    realpack = HvNAME(SvSTASH(ival));
+	else
+	    realpack = Nullch;
+	if ((svp = hv_fetch(seenhv, id, idlen, FALSE)) &&
+	    (sv = *svp) && SvROK(sv) &&
+	    (seenentry = (AV*)SvRV(sv))) {
+	    SV *othername;
+	    if ((svp = av_fetch(seenentry, 0, FALSE)) && (othername = *svp)) {
+		if (purity && *levelp > 0) {
+		    SV *postentry;
+		    
+		    if (realtype == SVt_PVHV)
+			sv_catpvn(retval, "{}", 2);
+		    else if (realtype == SVt_PVAV)
+			sv_catpvn(retval, "[]", 2);
+		    else
+			sv_catpvn(retval, "''", 2);
+		    postentry = newSVpv(name, namelen);
+		    sv_catpvn(postentry, " = ", 3);
+		    sv_catsv(postentry, othername);
+		    av_push(postav, postentry);
+		}
+		else {
+		    if (name[0] == '@' || name[0] == '%') {
+			if ((SvPVX(othername))[0] == '\\' &&
+			    (SvPVX(othername))[1] == name[0]) {
+			    sv_catpvn(retval, SvPVX(othername)+1, SvCUR(othername)-1);
+			}
+			else {
+			    sv_catpvn(retval, name, 1);
+			    sv_catpvn(retval, "{", 1);
+			    sv_catsv(retval, othername);
+			    sv_catpvn(retval, "}", 1);
+			}
+		    }
+		    else
+			sv_catsv(retval, othername);
+		}
+		return 1;
+	    }
+	    else {
+		warn("ref name not found for %s", id);
+		return 0;
+	    }
+	}
+	else {   /* store our name and continue */
+	    SV *namesv;
+	    if (name[0] == '@' || name[0] == '%') {
+		namesv = newSVpv("\\", 1);
+		sv_catpvn(namesv, name, namelen);
+	    }
+	    else if (realtype == SVt_PVCV && name[0] == '*') {
+		namesv = newSVpv("\\", 2);
+		sv_catpvn(namesv, name, namelen);
+		(SvPVX(namesv))[1] = '&';
+	    }
+	    else
+		namesv = newSVpv(name, namelen);
+	    seenentry = newAV();
+	    av_push(seenentry, namesv);
+	    (void)SvREFCNT_inc(val);
+	    av_push(seenentry, val);
+	    (void)hv_store(seenhv, id, strlen(id), newRV((SV*)seenentry), 0);
+	    SvREFCNT_dec(seenentry);
+	}
+	
+	(*levelp)++;
+	ipad = sv_x(Nullsv, SvPVX(xpad), SvCUR(xpad), *levelp);
+
+	if (realpack) {   /* we have a blessed ref */
+	    STRLEN blesslen;
+	    char *blessstr = SvPV(bless, blesslen);
+	    sv_catpvn(retval, blessstr, blesslen);
+	    sv_catpvn(retval, "( ", 2);
+	    if (indent >= 2) {
+		blesspad = apad;
+		apad = newSVsv(apad);
+		sv_x(apad, " ", 1, blesslen+2);
+	    }
+	}
+
+	if (realtype <= SVt_PVBM || realtype == SVt_PVGV) {  /* scalars */
+	    if (realpack && realtype != SVt_PVGV) {          /* blessed */ 
+		sv_catpvn(retval, "do{\\(my $o = ", 13);
+		DD_dump(ival, "", 0, retval, seenhv, postav,
+			levelp,	indent, pad, xpad, apad, sep,
+			freezer, toaster, purity, deepcopy, quotekeys, bless);
+		sv_catpvn(retval, ")}", 2);
+	    }
+	    else {
+		sv_catpvn(retval, "\\", 1);
+		DD_dump(ival, "", 0, retval, seenhv, postav,
+			levelp,	indent, pad, xpad, apad, sep,
+			freezer, toaster, purity, deepcopy, quotekeys, bless);
+	    }
+	}
+	else if (realtype == SVt_PVAV) {
+	    SV *totpad;
+	    I32 ix = 0;
+	    I32 ixmax = av_len((AV *)ival);
+	    
+	    SV *ixsv = newSViv(0);
+	    /* allowing for a 24 char wide array index */
+	    New(0, iname, namelen+28, char);
+	    (void)strcpy(iname, name);
+	    inamelen = namelen;
+	    if (name[0] == '@') {
+		sv_catpvn(retval, "(", 1);
+		iname[0] = '$';
+	    }
+	    else {
+		sv_catpvn(retval, "[", 1);
+		if (namelen > 0 && name[namelen-1] != ']' && name[namelen-1] != '}') {
+		    iname[inamelen++] = '-'; iname[inamelen++] = '>';
+		    iname[inamelen] = '\0';
+		}
+	    }
+	    if (iname[0] == '*' && iname[inamelen-1] == '}' && inamelen >= 8 &&
+		(instr(iname+inamelen-8, "{SCALAR}") ||
+		 instr(iname+inamelen-7, "{ARRAY}") ||
+		 instr(iname+inamelen-6, "{HASH}"))) {
+		iname[inamelen++] = '-'; iname[inamelen++] = '>';
+	    }
+	    iname[inamelen++] = '['; iname[inamelen] = '\0';
+	    totpad = newSVsv(sep);
+	    sv_catsv(totpad, pad);
+	    sv_catsv(totpad, apad);
+
+	    for (ix = 0; ix <= ixmax; ++ix) {
+		STRLEN ilen;
+		SV *elem;
+		svp = av_fetch((AV*)ival, ix, FALSE);
+		if (svp)
+		    elem = *svp;
+		else
+		    elem = &PL_sv_undef;
+		
+		ilen = inamelen;
+		sv_setiv(ixsv, ix);
+                (void) sprintf(iname+ilen, "%ld", ix);
+		ilen = strlen(iname);
+		iname[ilen++] = ']'; iname[ilen] = '\0';
+		if (indent >= 3) {
+		    sv_catsv(retval, totpad);
+		    sv_catsv(retval, ipad);
+		    sv_catpvn(retval, "#", 1);
+		    sv_catsv(retval, ixsv);
+		}
+		sv_catsv(retval, totpad);
+		sv_catsv(retval, ipad);
+		DD_dump(elem, iname, ilen, retval, seenhv, postav,
+			levelp,	indent, pad, xpad, apad, sep,
+			freezer, toaster, purity, deepcopy, quotekeys, bless);
+		if (ix < ixmax)
+		    sv_catpvn(retval, ",", 1);
+	    }
+	    if (ixmax >= 0) {
+		SV *opad = sv_x(Nullsv, SvPVX(xpad), SvCUR(xpad), (*levelp)-1);
+		sv_catsv(retval, totpad);
+		sv_catsv(retval, opad);
+		SvREFCNT_dec(opad);
+	    }
+	    if (name[0] == '@')
+		sv_catpvn(retval, ")", 1);
+	    else
+		sv_catpvn(retval, "]", 1);
+	    SvREFCNT_dec(ixsv);
+	    SvREFCNT_dec(totpad);
+	    Safefree(iname);
+	}
+	else if (realtype == SVt_PVHV) {
+	    SV *totpad, *newapad;
+	    SV *iname, *sname;
+	    HE *entry;
+	    char *key;
+	    I32 klen;
+	    SV *hval;
+	    
+	    iname = newSVpv(name, namelen);
+	    if (name[0] == '%') {
+		sv_catpvn(retval, "(", 1);
+		(SvPVX(iname))[0] = '$';
+	    }
+	    else {
+		sv_catpvn(retval, "{", 1);
+		if (namelen > 0 && name[namelen-1] != ']' && name[namelen-1] != '}') {
+		    sv_catpvn(iname, "->", 2);
+		}
+	    }
+	    if (name[0] == '*' && name[namelen-1] == '}' && namelen >= 8 &&
+		(instr(name+namelen-8, "{SCALAR}") ||
+		 instr(name+namelen-7, "{ARRAY}") ||
+		 instr(name+namelen-6, "{HASH}"))) {
+		sv_catpvn(iname, "->", 2);
+	    }
+	    sv_catpvn(iname, "{", 1);
+	    totpad = newSVsv(sep);
+	    sv_catsv(totpad, pad);
+	    sv_catsv(totpad, apad);
+	    
+	    (void)hv_iterinit((HV*)ival);
+	    i = 0;
+	    while ((entry = hv_iternext((HV*)ival)))  {
+		char *nkey;
+		I32 nticks = 0;
+		
+		if (i)
+		    sv_catpvn(retval, ",", 1);
+		i++;
+		key = hv_iterkey(entry, &klen);
+		hval = hv_iterval((HV*)ival, entry);
+
+		if (quotekeys || needs_quote(key)) {
+		    nticks = num_q(key, klen);
+		    New(0, nkey, klen+nticks+3, char);
+		    nkey[0] = '\'';
+		    if (nticks)
+			klen += esc_q(nkey+1, key, klen);
+		    else
+			(void)Copy(key, nkey+1, klen, char);
+		    nkey[++klen] = '\'';
+		    nkey[++klen] = '\0';
+		}
+		else {
+		    New(0, nkey, klen, char);
+		    (void)Copy(key, nkey, klen, char);
+		}
+		
+		sname = newSVsv(iname);
+		sv_catpvn(sname, nkey, klen);
+		sv_catpvn(sname, "}", 1);
+
+		sv_catsv(retval, totpad);
+		sv_catsv(retval, ipad);
+		sv_catpvn(retval, nkey, klen);
+		sv_catpvn(retval, " => ", 4);
+		if (indent >= 2) {
+		    char *extra;
+		    I32 elen = 0;
+		    newapad = newSVsv(apad);
+		    New(0, extra, klen+4+1, char);
+		    while (elen < (klen+4))
+			extra[elen++] = ' ';
+		    extra[elen] = '\0';
+		    sv_catpvn(newapad, extra, elen);
+		    Safefree(extra);
+		}
+		else
+		    newapad = apad;
+
+		DD_dump(hval, SvPVX(sname), SvCUR(sname), retval, seenhv,
+			postav, levelp,	indent, pad, xpad, newapad, sep,
+			freezer, toaster, purity, deepcopy, quotekeys, bless);
+		SvREFCNT_dec(sname);
+		Safefree(nkey);
+		if (indent >= 2)
+		    SvREFCNT_dec(newapad);
+	    }
+	    if (i) {
+		SV *opad = sv_x(Nullsv, SvPVX(xpad), SvCUR(xpad), *levelp-1);
+		sv_catsv(retval, totpad);
+		sv_catsv(retval, opad);
+		SvREFCNT_dec(opad);
+	    }
+	    if (name[0] == '%')
+		sv_catpvn(retval, ")", 1);
+	    else
+		sv_catpvn(retval, "}", 1);
+	    SvREFCNT_dec(iname);
+	    SvREFCNT_dec(totpad);
+	}
+	else if (realtype == SVt_PVCV) {
+	    sv_catpvn(retval, "sub { \"DUMMY\" }", 15);
+	    if (purity)
+		warn("Encountered CODE ref, using dummy placeholder");
+	}
+	else {
+	    warn("cannot handle ref type %ld", realtype);
+	}
+
+	if (realpack) {  /* free blessed allocs */
+	    if (indent >= 2) {
+		SvREFCNT_dec(apad);
+		apad = blesspad;
+	    }
+	    sv_catpvn(retval, ", '", 3);
+	    sv_catpvn(retval, realpack, strlen(realpack));
+	    sv_catpvn(retval, "' )", 3);
+	    if (toaster && SvPOK(toaster) && SvCUR(toaster)) {
+		sv_catpvn(retval, "->", 2);
+		sv_catsv(retval, toaster);
+		sv_catpvn(retval, "()", 2);
+	    }
+	}
+	SvREFCNT_dec(ipad);
+	(*levelp)--;
+    }
+    else {
+	STRLEN i;
+	
+	if (namelen) {
+	    (void) sprintf(id, "0x%lx", (unsigned long)val);
+	    if ((svp = hv_fetch(seenhv, id, (idlen = strlen(id)), FALSE)) &&
+		(sv = *svp) && SvROK(sv) &&
+		(seenentry = (AV*)SvRV(sv))) {
+		SV *othername;
+		if ((svp = av_fetch(seenentry, 0, FALSE)) && (othername = *svp)) {
+		    sv_catsv(retval, othername);
+		    return 1;
+		}
+	    }
+	    else {
+		SV *namesv;
+		namesv = newSVpv("\\", 1);
+		sv_catpvn(namesv, name, namelen);
+		seenentry = newAV();
+		av_push(seenentry, namesv);
+		(void)SvREFCNT_inc(val);
+		av_push(seenentry, val);
+		(void)hv_store(seenhv, id, strlen(id), newRV((SV*)seenentry), 0);
+		SvREFCNT_dec(seenentry);
+	    }
+	}
+	
+	if (SvIOK(val)) {
+            STRLEN len;
+	    i = SvIV(val);
+            (void) sprintf(tmpbuf, "%d", i);
+            len = strlen(tmpbuf);
+	    sv_catpvn(retval, tmpbuf, len);
+	    return 1;
+	}
+	else if (realtype == SVt_PVGV) {/* GLOBs can end up with scribbly names */
+	    c = SvPV(val, i);
+	    ++c; --i;			/* just get the name */
+	    if (i >= 6 && strncmp(c, "main::", 6) == 0) {
+		c += 4;
+		i -= 4;
+	    }
+	    if (needs_quote(c)) {
+		sv_grow(retval, SvCUR(retval)+6+2*i);
+		r = SvPVX(retval)+SvCUR(retval);
+		r[0] = '*'; r[1] = '{';	r[2] = '\'';
+		i += esc_q(r+3, c, i);
+		i += 3;
+		r[i++] = '\''; r[i++] = '}';
+		r[i] = '\0';
+	    }
+	    else {
+		sv_grow(retval, SvCUR(retval)+i+2);
+		r = SvPVX(retval)+SvCUR(retval);
+		r[0] = '*'; strcpy(r+1, c);
+		i++;
+	    }
+
+	    if (purity) {
+		static char *entries[] = { "{SCALAR}", "{ARRAY}", "{HASH}" };
+		static STRLEN sizes[] = { 8, 7, 6 };
+		SV *e;
+		SV *nname = newSVpv("", 0);
+		SV *newapad = newSVpv("", 0);
+		GV *gv = (GV*)val;
+		I32 j;
+		
+		for (j=0; j<3; j++) {
+		    e = ((j == 0) ? GvSV(gv) : (j == 1) ? (SV*)GvAV(gv) : (SV*)GvHV(gv));
+		    if (e) {
+			I32 nlevel = 0;
+			SV *postentry = newSVpv(r,i);
+			
+			sv_setsv(nname, postentry);
+			sv_catpvn(nname, entries[j], sizes[j]);
+			sv_catpvn(postentry, " = ", 3);
+			av_push(postav, postentry);
+			e = newRV(e);
+			
+			SvCUR(newapad) = 0;
+			if (indent >= 2)
+			    (void)sv_x(newapad, " ", 1, SvCUR(postentry));
+			
+			DD_dump(e, SvPVX(nname), SvCUR(nname), postentry,
+				seenhv, postav, &nlevel, indent, pad, xpad,
+				newapad, sep, freezer, toaster, purity,
+				deepcopy, quotekeys, bless);
+			SvREFCNT_dec(e);
+		    }
+		}
+		
+		SvREFCNT_dec(newapad);
+		SvREFCNT_dec(nname);
+	    }
+	}
+	else {
+	    c = SvPV(val, i);
+	    sv_grow(retval, SvCUR(retval)+3+2*i);
+	    r = SvPVX(retval)+SvCUR(retval);
+	    r[0] = '\'';
+	    i += esc_q(r+1, c, i);
+	    ++i;
+	    r[i++] = '\'';
+	    r[i] = '\0';
+	}
+	SvCUR_set(retval, SvCUR(retval)+i);
+    }
+
+    if (deepcopy && idlen)
+	(void)hv_delete(seenhv, id, idlen, G_DISCARD);
+	
+    return 1;
+}
+
+
+MODULE = Data::Dumper		PACKAGE = Data::Dumper         PREFIX = Data_Dumper_
+
+#
+# This is the exact equivalent of Dump.  Well, almost. The things that are
+# different as of now (due to Laziness):
+#   * doesnt do double-quotes yet.
+#
+
+void
+Data_Dumper_Dumpxs(href, ...)
+	SV	*href;
+	PROTOTYPE: $;$$
+	PPCODE:
+	{
+	    HV *hv;
+	    SV *retval, *valstr;
+	    HV *seenhv = Nullhv;
+	    AV *postav, *todumpav, *namesav;
+	    I32 level = 0;
+	    I32 indent, terse, useqq, i, imax, postlen;
+	    SV **svp;
+	    SV *val, *name, *pad, *xpad, *apad, *sep, *tmp, *varname;
+	    SV *freezer, *toaster, *bless;
+	    I32 purity, deepcopy, quotekeys;
+	    char tmpbuf[1024];
+	    I32 gimme = GIMME;
+
+	    if (!SvROK(href)) {		/* call new to get an object first */
+		SV *valarray;
+		SV *namearray;
+
+		if (items == 3) {
+		    valarray = ST(1);
+		    namearray = ST(2);
+		}
+		else
+		    croak("Usage: Data::Dumper::Dumpxs(PACKAGE, VAL_ARY_REF, NAME_ARY_REF)");
+		
+		ENTER;
+		SAVETMPS;
+		
+		PUSHMARK(sp);
+		XPUSHs(href);
+		XPUSHs(sv_2mortal(newSVsv(valarray)));
+		XPUSHs(sv_2mortal(newSVsv(namearray)));
+		PUTBACK;
+		i = perl_call_method("new", G_SCALAR);
+		SPAGAIN;
+		if (i)
+		    href = newSVsv(POPs);
+
+		PUTBACK;
+		FREETMPS;
+		LEAVE;
+		if (i)
+		    (void)sv_2mortal(href);
+	    }
+
+	    todumpav = namesav = Nullav;
+	    seenhv = Nullhv;
+	    val = pad = xpad = apad = sep = tmp = varname
+		= freezer = toaster = bless = &PL_sv_undef;
+	    name = sv_newmortal();
+	    indent = 2;
+	    terse = useqq = purity = deepcopy = 0;
+	    quotekeys = 1;
+	    
+	    retval = newSVpv("", 0);
+	    if (SvROK(href)
+		&& (hv = (HV*)SvRV((SV*)href))
+		&& SvTYPE(hv) == SVt_PVHV)		{
+
+		if ((svp = hv_fetch(hv, "seen", 4, FALSE)) && SvROK(*svp))
+		    seenhv = (HV*)SvRV(*svp);
+		if ((svp = hv_fetch(hv, "todump", 6, FALSE)) && SvROK(*svp))
+		    todumpav = (AV*)SvRV(*svp);
+		if ((svp = hv_fetch(hv, "names", 5, FALSE)) && SvROK(*svp))
+		    namesav = (AV*)SvRV(*svp);
+		if ((svp = hv_fetch(hv, "indent", 6, FALSE)))
+		    indent = SvIV(*svp);
+		if ((svp = hv_fetch(hv, "purity", 6, FALSE)))
+		    purity = SvIV(*svp);
+		if ((svp = hv_fetch(hv, "terse", 5, FALSE)))
+		    terse = SvTRUE(*svp);
+		if ((svp = hv_fetch(hv, "useqq", 5, FALSE)))
+		    useqq = SvTRUE(*svp);
+		if ((svp = hv_fetch(hv, "pad", 3, FALSE)))
+		    pad = *svp;
+		if ((svp = hv_fetch(hv, "xpad", 4, FALSE)))
+		    xpad = *svp;
+		if ((svp = hv_fetch(hv, "apad", 4, FALSE)))
+		    apad = *svp;
+		if ((svp = hv_fetch(hv, "sep", 3, FALSE)))
+		    sep = *svp;
+		if ((svp = hv_fetch(hv, "varname", 7, FALSE)))
+		    varname = *svp;
+		if ((svp = hv_fetch(hv, "freezer", 7, FALSE)))
+		    freezer = *svp;
+		if ((svp = hv_fetch(hv, "toaster", 7, FALSE)))
+		    toaster = *svp;
+		if ((svp = hv_fetch(hv, "deepcopy", 8, FALSE)))
+		    deepcopy = SvTRUE(*svp);
+		if ((svp = hv_fetch(hv, "quotekeys", 9, FALSE)))
+		    quotekeys = SvTRUE(*svp);
+		if ((svp = hv_fetch(hv, "bless", 5, FALSE)))
+		    bless = *svp;
+		postav = newAV();
+
+		if (todumpav)
+		    imax = av_len(todumpav);
+		else
+		    imax = -1;
+		valstr = newSVpv("",0);
+		for (i = 0; i <= imax; ++i) {
+		    SV *newapad;
+		    
+		    av_clear(postav);
+		    if ((svp = av_fetch(todumpav, i, FALSE)))
+			val = *svp;
+		    else
+			val = &PL_sv_undef;
+		    if ((svp = av_fetch(namesav, i, TRUE)))
+			sv_setsv(name, *svp);
+		    else
+			SvOK_off(name);
+		    
+		    if (SvOK(name)) {
+			if ((SvPVX(name))[0] == '*') {
+			    if (SvROK(val)) {
+				switch (SvTYPE(SvRV(val))) {
+				case SVt_PVAV:
+				    (SvPVX(name))[0] = '@';
+				    break;
+				case SVt_PVHV:
+				    (SvPVX(name))[0] = '%';
+				    break;
+				case SVt_PVCV:
+				    (SvPVX(name))[0] = '*';
+				    break;
+				default:
+				    (SvPVX(name))[0] = '$';
+				    break;
+				}
+			    }
+			    else
+				(SvPVX(name))[0] = '$';
+			}
+			else if ((SvPVX(name))[0] != '$')
+			    sv_insert(name, 0, 0, "$", 1);
+		    }
+		    else {
+			STRLEN nchars = 0;
+			sv_setpvn(name, "$", 1);
+			sv_catsv(name, varname);
+			(void) sprintf(tmpbuf, "%ld", i+1);
+			nchars = strlen(tmpbuf);
+			sv_catpvn(name, tmpbuf, nchars);
+		    }
+		    
+		    if (indent >= 2) {
+			SV *tmpsv = sv_x(Nullsv, " ", 1, SvCUR(name)+3);
+			newapad = newSVsv(apad);
+			sv_catsv(newapad, tmpsv);
+			SvREFCNT_dec(tmpsv);
+		    }
+		    else
+			newapad = apad;
+		    
+		    DD_dump(val, SvPVX(name), SvCUR(name), valstr, seenhv,
+			    postav, &level, indent, pad, xpad, newapad, sep,
+			    freezer, toaster, purity, deepcopy, quotekeys,
+			    bless);
+		    
+		    if (indent >= 2)
+			SvREFCNT_dec(newapad);
+
+		    postlen = av_len(postav);
+		    if (postlen >= 0 || !terse) {
+			sv_insert(valstr, 0, 0, " = ", 3);
+			sv_insert(valstr, 0, 0, SvPVX(name), SvCUR(name));
+			sv_catpvn(valstr, ";", 1);
+		    }
+		    sv_catsv(retval, pad);
+		    sv_catsv(retval, valstr);
+		    sv_catsv(retval, sep);
+		    if (postlen >= 0) {
+			I32 i;
+			sv_catsv(retval, pad);
+			for (i = 0; i <= postlen; ++i) {
+			    SV *elem;
+			    svp = av_fetch(postav, i, FALSE);
+			    if (svp && (elem = *svp)) {
+				sv_catsv(retval, elem);
+				if (i < postlen) {
+				    sv_catpvn(retval, ";", 1);
+				    sv_catsv(retval, sep);
+				    sv_catsv(retval, pad);
+				}
+			    }
+			}
+			sv_catpvn(retval, ";", 1);
+			    sv_catsv(retval, sep);
+		    }
+		    sv_setpvn(valstr, "", 0);
+		    if (gimme == G_ARRAY) {
+			XPUSHs(sv_2mortal(retval));
+			if (i < imax)	/* not the last time thro ? */
+			    retval = newSVpv("",0);
+		    }
+		}
+		SvREFCNT_dec(postav);
+		SvREFCNT_dec(valstr);
+	    }
+	    else
+		croak("Call to new() method failed to return HASH ref");
+	    if (gimme == G_SCALAR)
+		XPUSHs(sv_2mortal(retval));
+	}
diff --git a/contrib/perl5/ext/Data/Dumper/Makefile.PL b/contrib/perl5/ext/Data/Dumper/Makefile.PL
new file mode 100644
index 0000000..6c94e95d
--- /dev/null
+++ b/contrib/perl5/ext/Data/Dumper/Makefile.PL
@@ -0,0 +1,11 @@
+use ExtUtils::MakeMaker;
+WriteMakefile(
+	NAME		=> "Data::Dumper",
+	VERSION_FROM	=> 'Dumper.pm',
+	'dist'		=> {
+			     COMPRESS	=> 'gzip -9f',
+	      		     SUFFIX	=> 'gz',
+	      		     DIST_DEFAULT => 'all tardist',
+			   },
+	MAN3PODS	=> ' ',
+);
diff --git a/contrib/perl5/ext/Data/Dumper/Todo b/contrib/perl5/ext/Data/Dumper/Todo
new file mode 100644
index 0000000..4a41f97
--- /dev/null
+++ b/contrib/perl5/ext/Data/Dumper/Todo
@@ -0,0 +1,32 @@
+=head1 NAME
+
+TODO - seeds germane, yet not germinated
+
+=head1 DESCRIPTION
+
+The following functionality will be supported in the next few releases.
+
+=over 4
+
+=item $Data::Dumper::Maxdepth I<or> $I<OBJ>->Maxdepth(I<NEWVAL>)
+
+Depth beyond which we don't venture into a structure.  Has no effect when
+C<Data::Dumper::Purity> is set.  (useful in debugger when we often don't
+want to see more than enough).
+
+=item  $Data::Dumper::Expdepth I<or> $I<OBJ>->Expdepth(I<NEWVAL>)
+
+Dump contents explicitly up to a certain depth and then use names for
+cross-referencing identical references.  (useful in debugger, in situations
+where we don't care so much for cross-references).
+
+=item Make C<Dumpxs()> honor C<$Useqq>
+
+=item Fix formatting when Terse is set and Indent >= 2
+
+=item Output space after '\' (ref constructor) for high enough Indent
+
+=item Implement redesign that allows various backends (Perl, Lisp,
+some-binary-data-format, graph-description-languages, etc.)
+
+=back
diff --git a/contrib/perl5/ext/DynaLoader/DynaLoader_pm.PL b/contrib/perl5/ext/DynaLoader/DynaLoader_pm.PL
new file mode 100644
index 0000000..4c41559
--- /dev/null
+++ b/contrib/perl5/ext/DynaLoader/DynaLoader_pm.PL
@@ -0,0 +1,729 @@
+
+use Config;
+
+sub to_string {
+    my ($value) = @_;
+    $value =~ s/\\/\\\\'/g;
+    $value =~ s/'/\\'/g;
+    return "'$value'";
+}
+
+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)
+
+package DynaLoader;
+
+#   And Gandalf said: 'Many folk like to know beforehand what is to
+#   be set on the table; but those who have laboured to prepare the
+#   feast like to keep their secret; for wonder makes the words of
+#   praise louder.'
+
+#   (Quote from Tolkien sugested 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 = $VERSION = "1.03";	# avoid typo warning
+
+require AutoLoader;
+*AUTOLOAD = \&AutoLoader::AUTOLOAD;
+
+# 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 
+# if Carp hasn't been loaded in earlier compile time. :-( 
+# 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;
+
+#
+# Flags to alter dl_load_file behaviour.  Assigned bits:
+#   0x01  make symbols available for linking later dl_load_file's.
+#         (only known to work on Solaris 2 using dlopen(RTLD_GLOBAL))
+#         (ignored under VMS; effect is built-in to image linking)
+#
+# This is called as a class method $module->dl_load_flags.  The
+# definition here will be inherited and result on "default" loading
+# behaviour unless a sub-class of DynaLoader defines its own version.
+#
+
+sub dl_load_flags { 0x00 }
+
+# ($dl_dlext, $dlsrc)
+#         = @Config::Config{'dlext', 'dlsrc'};
+EOT
+
+print OUT "  (\$dl_dlext, \$dlsrc) = (",
+          to_string($Config::Config{'dlext'}), ",",
+          to_string($Config::Config{'dlsrc'}), ")\n;" ;
+
+print OUT <<'EOT';
+
+# Some systems need special handling to expand file specifications
+# (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';
+
+@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
+
+# 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
+
+# push(@dl_library_path, split(' ', $Config::Config{'libpth'});
+EOT
+
+print OUT "push(\@dl_library_path, split(' ', ",
+          to_string($Config::Config{'libpth'}), "));\n";
+
+print OUT <<'EOT';
+
+# Add to @dl_library_path any extra directories we can gather from
+# environment variables. So far LD_LIBRARY_PATH is the only known
+# variable used for this purpose. Others may be added later.
+push(@dl_library_path, split(/:/, $ENV{LD_LIBRARY_PATH}))
+    if $ENV{LD_LIBRARY_PATH};
+
+
+# No prizes for guessing why we don't say 'bootstrap DynaLoader;' here.
+boot_DynaLoader('DynaLoader') if defined(&boot_DynaLoader);
+
+
+if ($dl_debug) {
+    print STDERR "DynaLoader.pm loaded (@INC, @dl_library_path)\n";
+    print STDERR "DynaLoader not linked into this perl\n"
+	    unless defined(&boot_DynaLoader);
+}
+
+1; # End of main code
+
+
+sub croak   { require Carp; Carp::croak(@_)   }
+
+# The bootstrap function cannot be autoloaded (without complications)
+# so we define it here:
+
+sub bootstrap {
+    # use local vars to enable $module.bs script to edit values
+    local(@args) = @_;
+    local($module) = $args[0];
+    local(@dirs, $file);
+
+    unless ($module) {
+	require Carp;
+	Carp::confess("Usage: DynaLoader::bootstrap(module)");
+    }
+
+    # A common error on platforms which don't support dynamic loading.
+    # Since it's fatal and potentially confusing we give a detailed message.
+    croak("Can't load module $module, dynamic loading not available in this perl.\n".
+	"  (You may need to build a new perl executable which either supports\n".
+	"  dynamic loading or has the $module module statically linked into it.)\n")
+	unless defined(&dl_load_file);
+
+    my @modparts = split(/::/,$module);
+    my $modfname = $modparts[-1];
+
+    # Some systems have restrictions on files names for DLL's etc.
+    # mod2fname returns appropriate file base name (typically truncated)
+    # It may also edit @modparts if required.
+    $modfname = &mod2fname(\@modparts) if defined &mod2fname;
+
+    my $modpname = join('/',@modparts);
+
+    print STDERR "DynaLoader::bootstrap for $module ",
+		"(auto/$modpname/$modfname.$dl_dlext)\n" if $dl_debug;
+
+    foreach (@INC) {
+	chop($_ = VMS::Filespec::unixpath($_)) if $Is_VMS;
+	my $dir = "$_/auto/$modpname";
+	next unless -d $dir; # skip over uninteresting directories
+
+	# check for common cases to avoid autoload of dl_findfile
+	my $try = "$dir/$modfname.$dl_dlext";
+	last if $file = ($do_expand) ? dl_expandspec($try) : (-f $try && $try);
+
+	# no luck here, save dir for possible later dl_findfile search
+	push @dirs, $dir;
+    }
+    # last resort, let dl_findfile have a go in all known locations
+    $file = dl_findfile(map("-L$_",@dirs,@INC), $modfname) unless $file;
+
+    croak("Can't locate loadable object for module $module in \@INC (\@INC contains: @INC)")
+	unless $file;	# wording similar to error from 'require'
+
+    my $bootname = "boot_$module";
+    $bootname =~ s/\W/_/g;
+    @dl_require_symbols = ($bootname);
+
+    # Execute optional '.bootstrap' perl script for this module.
+    # The .bs file can be used to configure @dl_resolve_using etc to
+    # match the needs of the individual module on this architecture.
+    my $bs = $file;
+    $bs =~ s/(\.\w+)?$/\.bs/; # look for .bs 'beside' the library
+    if (-s $bs) { # only read file if it's not empty
+        print STDERR "BS: $bs ($^O, $dlsrc)\n" if $dl_debug;
+        eval { do $bs; };
+        warn "$bs: $@\n" if $@;
+    }
+
+    # Many dynamic extension loading problems will appear to come from
+    # this section of code: XYZ failed at line 123 of DynaLoader.pm.
+    # Often these errors are actually occurring in the initialisation
+    # C code of the extension XS file. Perl reports the error as being
+    # in this perl code simply because this was the last perl code
+    # it executed.
+
+    my $libref = dl_load_file($file, $module->dl_load_flags) or
+	croak("Can't load '$file' for module $module: ".dl_error()."\n");
+
+    push(@dl_librefs,$libref);  # record loaded object
+
+    my @unresolved = dl_undef_symbols();
+    if (@unresolved) {
+	require Carp;
+	Carp::carp("Undefined symbols present after loading $file: @unresolved\n");
+    }
+
+    my $boot_symbol_ref = dl_find_symbol($libref, $bootname) or
+         croak("Can't find '$bootname' symbol in $file\n");
+
+    my $xs = dl_install_xsub("${module}::bootstrap", $boot_symbol_ref, $file);
+
+    push(@dl_modules, $module); # record loaded module
+
+    # See comment block above
+    &$xs(@args);
+}
+
+
+#sub _check_file {   # private utility to handle dl_expandspec vs -f tests
+#    my($file) = @_;
+#    return $file if (!$do_expand && -f $file); # the common case
+#    return $file if ( $do_expand && ($file=dl_expandspec($file)));
+#    return undef;
+#}
+
+
+# Let autosplit and the autoloader deal with these functions:
+__END__
+
+
+sub dl_findfile {
+    # Read ext/DynaLoader/DynaLoader.doc for detailed information.
+    # This function does not automatically consider the architecture
+    # or the perl library auto directories.
+    my (@args) = @_;
+    my (@dirs,  $dir);   # which directories to search
+    my (@found);         # full paths to real files we have found
+EOT
+
+print OUT '    my $dl_ext= ' . to_string($Config::Config{'dlext'}) .
+          "; # \$Config::Config{'dlext'} suffix for perl extensions\n";
+print OUT '    my $dl_so = ' . to_string($Config::Config{'so'}) .
+          "; # \$Config::Config{'so'} suffix for shared libraries\n";
+
+print OUT <<'EOT';
+
+    print STDERR "dl_findfile(@args)\n" if $dl_debug;
+
+    # accumulate directories but process files as they appear
+    arg: foreach(@args) {
+        #  Special fast case: full filepath requires no search
+        if ($Is_VMS && m%[:>/\]]% && -f $_) {
+	    push(@found,dl_expandspec(VMS::Filespec::vmsify($_)));
+	    last arg unless wantarray;
+	    next;
+        }
+        elsif (m:/: && -f $_ && !$do_expand) {
+	    push(@found,$_);
+	    last arg unless wantarray;
+	    next;
+	}
+
+        # Deal with directories first:
+        #  Using a -L prefix is the preferred option (faster and more robust)
+        if (m:^-L:) { s/^-L//; push(@dirs, $_); next; }
+
+        #  Otherwise we try to try to spot directories by a heuristic
+        #  (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
+        # Unix emulation, so check this as well
+        if ($Is_VMS && /[:>\]]/ && -d $_) {   push(@dirs, $_); next; }
+
+        #  Only files should get this far...
+        my(@names, $name);    # what filenames to look for
+        if (m:-l: ) {          # convert -lname to appropriate library name
+            s/-l//;
+            push(@names,"lib$_.$dl_so");
+            push(@names,"lib$_.a");
+        } else {                # Umm, a bare name. Try various alternatives:
+            # these should be ordered with the most likely first
+            push(@names,"$_.$dl_ext")    unless m/\.$dl_ext$/o;
+            push(@names,"$_.$dl_so")     unless m/\.$dl_so$/o;
+            push(@names,"lib$_.$dl_so")  unless m:/:;
+            push(@names,"$_.a")          if !m/\.a$/ and $dlsrc eq "dl_dld.xs";
+            push(@names, $_);
+        }
+        foreach $dir (@dirs, @dl_library_path) {
+            next unless -d $dir;
+            chop($dir = VMS::Filespec::unixpath($dir)) if $Is_VMS;
+            foreach $name (@names) {
+		my($file) = "$dir/$name";
+                print STDERR " checking in $dir for $name\n" if $dl_debug;
+		$file = ($do_expand) ? dl_expandspec($file) : (-f $file && $file);
+		#$file = _check_file($file);
+		if ($file) {
+                    push(@found, $file);
+                    next arg; # no need to look any further
+                }
+            }
+        }
+    }
+    if ($dl_debug) {
+        foreach(@dirs) {
+            print STDERR " dl_findfile ignored non-existent directory: $_\n" unless -d $_;
+        }
+        print STDERR "dl_findfile found: @found\n";
+    }
+    return $found[0] unless wantarray;
+    @found;
+}
+
+
+sub dl_expandspec {
+    my($spec) = @_;
+    # Optional function invoked if DynaLoader.pm sets $do_expand.
+    # Most systems do not require or use this function.
+    # Some systems may implement it in the dl_*.xs file in which case
+    # this autoload version will not be called but is harmless.
+
+    # This function is designed to deal with systems which treat some
+    # 'filenames' in a special way. For example VMS 'Logical Names'
+    # (something like unix environment variables - but different).
+    # This function should recognise such names and expand them into
+    # full file paths.
+    # Must return undef if $spec is invalid or file does not exist.
+
+    my $file = $spec; # default output to input
+
+    if ($Is_VMS) { # dl_expandspec should be defined in dl_vms.xs
+	require Carp;
+	Carp::croak("dl_expandspec: should be defined in XS file!\n");
+    } else {
+	return undef unless -f $file;
+    }
+    print STDERR "dl_expandspec($spec) => $file\n" if $dl_debug;
+    $file;
+}
+
+sub dl_find_symbol_anywhere
+{
+    my $sym = shift;
+    my $libref;
+    foreach $libref (@dl_librefs) {
+	my $symref = dl_find_symbol($libref,$sym);
+	return $symref if $symref;
+    }
+    return undef;
+}
+
+=head1 NAME
+
+DynaLoader - Dynamically load C libraries into Perl code
+
+dl_error(), dl_findfile(), dl_expandspec(), dl_load_file(), dl_find_symbol(), dl_find_symbol_anywhere(), dl_undef_symbols(), dl_install_xsub(), dl_load_flags(), bootstrap() - routines used by DynaLoader modules
+
+=head1 SYNOPSIS
+
+    package YourPackage;
+    require DynaLoader;
+    @ISA = qw(... DynaLoader ...);
+    bootstrap YourPackage;
+
+    # optional method for 'global' loading
+    sub dl_load_flags { 0x01 }     
+
+
+=head1 DESCRIPTION
+
+This document defines a standard generic interface to the dynamic
+linking mechanisms available on many platforms.  Its primary purpose is
+to implement automatic dynamic loading of Perl modules.
+
+This document serves as both a specification for anyone wishing to
+implement the DynaLoader for a new platform and as a guide for
+anyone wishing to use the DynaLoader directly in an application.
+
+The DynaLoader is designed to be a very simple high-level
+interface that is sufficiently general to cover the requirements
+of SunOS, HP-UX, NeXT, Linux, VMS and other platforms.
+
+It is also hoped that the interface will cover the needs of OS/2, NT
+etc and also allow pseudo-dynamic linking (using C<ld -A> at runtime).
+
+It must be stressed that the DynaLoader, by itself, is practically
+useless for accessing non-Perl libraries because it provides almost no
+Perl-to-C 'glue'.  There is, for example, no mechanism for calling a C
+library function or supplying arguments.  A C::DynaLib module
+is available from CPAN sites which performs that function for some
+common system types.
+
+DynaLoader Interface Summary
+
+  @dl_library_path
+  @dl_resolve_using
+  @dl_require_symbols
+  $dl_debug
+  @dl_librefs
+  @dl_modules
+                                                  Implemented in:
+  bootstrap($modulename)                               Perl
+  @filepaths = dl_findfile(@names)                     Perl
+  $flags = $modulename->dl_load_flags                  Perl
+  $symref  = dl_find_symbol_anywhere($symbol)          Perl
+
+  $libref  = dl_load_file($filename, $flags)           C
+  $symref  = dl_find_symbol($libref, $symbol)          C
+  @symbols = dl_undef_symbols()                        C
+  dl_install_xsub($name, $symref [, $filename])        C
+  $message = dl_error                                  C
+
+=over 4
+
+=item @dl_library_path
+
+The standard/default list of directories in which dl_findfile() will
+search for libraries etc.  Directories are searched in order:
+$dl_library_path[0], [1], ... etc
+
+@dl_library_path is initialised to hold the list of 'normal' directories
+(F</usr/lib>, etc) determined by B<Configure> (C<$Config{'libpth'}>).  This should
+ensure portability across a wide range of platforms.
+
+@dl_library_path should also be initialised with any other directories
+that can be determined from the environment at runtime (such as
+LD_LIBRARY_PATH for SunOS).
+
+After initialisation @dl_library_path can be manipulated by an
+application using push and unshift before calling dl_findfile().
+Unshift can be used to add directories to the front of the search order
+either to save search time or to override libraries with the same name
+in the 'normal' directories.
+
+The load function that dl_load_file() calls may require an absolute
+pathname.  The dl_findfile() function and @dl_library_path can be
+used to search for and return the absolute pathname for the
+library/object that you wish to load.
+
+=item @dl_resolve_using
+
+A list of additional libraries or other shared objects which can be
+used to resolve any undefined symbols that might be generated by a
+later call to load_file().
+
+This is only required on some platforms which do not handle dependent
+libraries automatically.  For example the Socket Perl extension
+library (F<auto/Socket/Socket.so>) contains references to many socket
+functions which need to be resolved when it's loaded.  Most platforms
+will automatically know where to find the 'dependent' library (e.g.,
+F</usr/lib/libsocket.so>).  A few platforms need to be told the
+location of the dependent library explicitly.  Use @dl_resolve_using
+for this.
+
+Example usage:
+
+    @dl_resolve_using = dl_findfile('-lsocket');
+
+=item @dl_require_symbols
+
+A list of one or more symbol names that are in the library/object file
+to be dynamically loaded.  This is only required on some platforms.
+
+=item @dl_librefs
+
+An array of the handles returned by successful calls to dl_load_file(),
+made by bootstrap, in the order in which they were loaded.
+Can be used with dl_find_symbol() to look for a symbol in any of
+the loaded files.
+
+=item @dl_modules
+
+An array of module (package) names that have been bootstrap'ed.
+
+=item dl_error()
+
+Syntax:
+
+    $message = dl_error();
+
+Error message text from the last failed DynaLoader function.  Note
+that, similar to errno in unix, a successful function call does not
+reset this message.
+
+Implementations should detect the error as soon as it occurs in any of
+the other functions and save the corresponding message for later
+retrieval.  This will avoid problems on some platforms (such as SunOS)
+where the error message is very temporary (e.g., dlerror()).
+
+=item $dl_debug
+
+Internal debugging messages are enabled when $dl_debug is set true.
+Currently setting $dl_debug only affects the Perl side of the
+DynaLoader.  These messages should help an application developer to
+resolve any DynaLoader usage problems.
+
+$dl_debug is set to C<$ENV{'PERL_DL_DEBUG'}> if defined.
+
+For the DynaLoader developer/porter there is a similar debugging
+variable added to the C code (see dlutils.c) and enabled if Perl was
+built with the B<-DDEBUGGING> flag.  This can also be set via the
+PERL_DL_DEBUG environment variable.  Set to 1 for minimal information or
+higher for more.
+
+=item dl_findfile()
+
+Syntax:
+
+    @filepaths = dl_findfile(@names)
+
+Determine the full paths (including file suffix) of one or more
+loadable files given their generic names and optionally one or more
+directories.  Searches directories in @dl_library_path by default and
+returns an empty list if no files were found.
+
+Names can be specified in a variety of platform independent forms.  Any
+names in the form B<-lname> are converted into F<libname.*>, where F<.*> is
+an appropriate suffix for the platform.
+
+If a name does not already have a suitable prefix and/or suffix then
+the corresponding file will be searched for by trying combinations of
+prefix and suffix appropriate to the platform: "$name.o", "lib$name.*"
+and "$name".
+
+If any directories are included in @names they are searched before
+@dl_library_path.  Directories may be specified as B<-Ldir>.  Any other
+names are treated as filenames to be searched for.
+
+Using arguments of the form C<-Ldir> and C<-lname> is recommended.
+
+Example: 
+
+    @dl_resolve_using = dl_findfile(qw(-L/usr/5lib -lposix));
+
+
+=item dl_expandspec()
+
+Syntax:
+
+    $filepath = dl_expandspec($spec)
+
+Some unusual systems, such as VMS, require special filename handling in
+order to deal with symbolic names for files (i.e., VMS's Logical Names).
+
+To support these systems a dl_expandspec() function can be implemented
+either in the F<dl_*.xs> file or code can be added to the autoloadable
+dl_expandspec() function in F<DynaLoader.pm>.  See F<DynaLoader.pm> for
+more information.
+
+=item dl_load_file()
+
+Syntax:
+
+    $libref = dl_load_file($filename, $flags)
+
+Dynamically load $filename, which must be the path to a shared object
+or library.  An opaque 'library reference' is returned as a handle for
+the loaded object.  Returns undef on error.
+
+The $flags argument to alters dl_load_file behaviour.  
+Assigned bits:
+
+ 0x01  make symbols available for linking later dl_load_file's.
+       (only known to work on Solaris 2 using dlopen(RTLD_GLOBAL))
+       (ignored under VMS; this is a normal part of image linking)
+
+(On systems that provide a handle for the loaded object such as SunOS
+and HPUX, $libref will be that handle.  On other systems $libref will
+typically be $filename or a pointer to a buffer containing $filename.
+The application should not examine or alter $libref in any way.)
+
+This is the function that does the real work.  It should use the
+current values of @dl_require_symbols and @dl_resolve_using if required.
+
+    SunOS: dlopen($filename)
+    HP-UX: shl_load($filename)
+    Linux: dld_create_reference(@dl_require_symbols); dld_link($filename)
+    NeXT:  rld_load($filename, @dl_resolve_using)
+    VMS:   lib$find_image_symbol($filename,$dl_require_symbols[0])
+
+(The dlopen() function is also used by Solaris and some versions of
+Linux, and is a common choice when providing a "wrapper" on other
+mechanisms as is done in the OS/2 port.)
+
+=item dl_loadflags()
+
+Syntax:
+
+    $flags = dl_loadflags $modulename;
+
+Designed to be a method call, and to be overridden by a derived class
+(i.e. a class which has DynaLoader in its @ISA).  The definition in
+DynaLoader itself returns 0, which produces standard behavior from
+dl_load_file().
+
+=item dl_find_symbol()
+
+Syntax:
+
+    $symref = dl_find_symbol($libref, $symbol)
+
+Return the address of the symbol $symbol or C<undef> if not found.  If the
+target system has separate functions to search for symbols of different
+types then dl_find_symbol() should search for function symbols first and
+then other types.
+
+The exact manner in which the address is returned in $symref is not
+currently defined.  The only initial requirement is that $symref can
+be passed to, and understood by, dl_install_xsub().
+
+    SunOS: dlsym($libref, $symbol)
+    HP-UX: shl_findsym($libref, $symbol)
+    Linux: dld_get_func($symbol) and/or dld_get_symbol($symbol)
+    NeXT:  rld_lookup("_$symbol")
+    VMS:   lib$find_image_symbol($libref,$symbol)
+
+
+=item dl_find_symbol_anywhere()
+
+Syntax:
+
+    $symref = dl_find_symbol_anywhere($symbol)
+
+Applies dl_find_symbol() to the members of @dl_librefs and returns
+the first match found.
+
+=item dl_undef_symbols()
+
+Example
+
+    @symbols = dl_undef_symbols()
+
+Return a list of symbol names which remain undefined after load_file().
+Returns C<()> if not known.  Don't worry if your platform does not provide
+a mechanism for this.  Most do not need it and hence do not provide it,
+they just return an empty list.
+
+
+=item dl_install_xsub()
+
+Syntax:
+
+    dl_install_xsub($perl_name, $symref [, $filename])
+
+Create a new Perl external subroutine named $perl_name using $symref as
+a pointer to the function which implements the routine.  This is simply
+a direct call to newXSUB().  Returns a reference to the installed
+function.
+
+The $filename parameter is used by Perl to identify the source file for
+the function if required by die(), caller() or the debugger.  If
+$filename is not defined then "DynaLoader" will be used.
+
+
+=item bootstrap()
+
+Syntax:
+
+bootstrap($module)
+
+This is the normal entry point for automatic dynamic loading in Perl.
+
+It performs the following actions:
+
+=over 8
+
+=item *
+
+locates an auto/$module directory by searching @INC
+
+=item *
+
+uses dl_findfile() to determine the filename to load
+
+=item *
+
+sets @dl_require_symbols to C<("boot_$module")>
+
+=item *
+
+executes an F<auto/$module/$module.bs> file if it exists
+(typically used to add to @dl_resolve_using any files which
+are required to load the module on the current platform)
+
+=item *
+
+calls dl_load_flags() to determine how to load the file.
+
+=item *
+
+calls dl_load_file() to load the file
+
+=item *
+
+calls dl_undef_symbols() and warns if any symbols are undefined
+
+=item *
+
+calls dl_find_symbol() for "boot_$module"
+
+=item *
+
+calls dl_install_xsub() to install it as "${module}::bootstrap"
+
+=item *
+
+calls &{"${module}::bootstrap"} to bootstrap the module (actually
+it uses the function reference returned by dl_install_xsub for speed)
+
+=back
+
+=back
+
+
+=head1 AUTHOR
+
+Tim Bunce, 11 August 1994.
+
+This interface is based on the work and comments of (in no particular
+order): Larry Wall, Robert Sanders, Dean Roehrich, Jeff Okamoto, Anno
+Siegel, Thomas Neumann, Paul Marquess, Charles Bailey, myself and others.
+
+Larry Wall designed the elegant inherited bootstrap mechanism and
+implemented the first Perl 5 dynamic loader using it.
+
+Solaris global loading added by Nick Ing-Simmons with design/coding
+assistance from Tim Bunce, January 1996.
+
+=cut
+EOT
+
+close OUT or die $!;
+
diff --git a/contrib/perl5/ext/DynaLoader/Makefile.PL b/contrib/perl5/ext/DynaLoader/Makefile.PL
new file mode 100644
index 0000000..7a75115
--- /dev/null
+++ b/contrib/perl5/ext/DynaLoader/Makefile.PL
@@ -0,0 +1,29 @@
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+    NAME => 'DynaLoader',
+    LINKTYPE	=> 'static',
+    DEFINE	=> '-DPERL_CORE -DLIBC="$(LIBC)"',
+    MAN3PODS 	=> ' ', 	# Pods will be built by installman.
+    SKIP	=> [qw(dynamic dynamic_lib dynamic_bs)],
+    XSPROTOARG => '-noprototypes', 		# XXX remove later?
+    VERSION_FROM => 'DynaLoader_pm.PL',
+    PL_FILES	=> {'DynaLoader_pm.PL'=>'DynaLoader.pm'},
+    PM		=> {'DynaLoader.pm' => '$(INST_LIBDIR)/DynaLoader.pm'},
+    clean	=> {FILES => 'DynaLoader.c DynaLoader.xs DynaLoader.pm'},
+);
+
+sub MY::postamble {
+	'
+DynaLoader.xs: $(DLSRC)
+	$(CP) $? $@
+
+# Perform very simple tests just to check for major gaffs.
+# We can\'t do much more for platforms we are not executing on.
+test-xs:
+	for i in dl_*xs; \
+	    do $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSUBPPARGS) $$i > /dev/null; \
+	done
+';
+}
+
diff --git a/contrib/perl5/ext/DynaLoader/README b/contrib/perl5/ext/DynaLoader/README
new file mode 100644
index 0000000..0551cf3
--- /dev/null
+++ b/contrib/perl5/ext/DynaLoader/README
@@ -0,0 +1,53 @@
+Perl 5 DynaLoader
+
+See DynaLoader.pm for detailed specification.
+
+This module is very similar to the other Perl 5 modules except that
+Configure selects which dl_*.xs file to use.
+
+After Configure has been run the Makefile.PL will generate a Makefile
+which will run xsubpp on a specific dl_*.xs file and write the output
+to DynaLoader.c
+
+After that the processing is the same as any other module.
+
+Note that, to be effective, the DynaLoader module must be _statically_
+linked into perl! Configure should arrange this.
+
+This interface is based on the work and comments of (in no particular
+order): Larry Wall, Robert Sanders, Dean Roehrich, Jeff Okamoto, Anno
+Siegel, Thomas Neumann, Paul Marquess, Charles Bailey and others.
+
+The dl_*.xs files should either be named after the dynamic linking
+operating system interface used if that interface is available on more
+than one type of system, e.g.:
+	dlopen  for dlopen()/dlsym() type functions (SunOS, BSD)
+	dld     for the GNU dld library functions (linux, ?)
+or else the osname, e.g., hpux, next, vms etc.
+
+Both are determined by Configure and so only those specific names that
+Configure knows/uses will work.
+
+If porting the DynaLoader to a platform that has a core dynamic linking
+interface similar to an existing generic type, e.g., dlopen or dld,
+please try to port the corresponding dl_*.xs file (using #ifdef's if
+required).
+
+Otherwise, or if that proves too messy, create a new dl_*.xs file named
+after your osname. Configure will give preference to a dl_$osname.xs
+file if one exists.
+
+The file dl_dlopen.xs is a reference implementation by Paul Marquess
+which is a good place to start if porting from scratch. For more complex
+platforms take a look at dl_dld.xs. The dlutils.c file holds some
+common definitions that are #included into the dl_*.xs files.
+
+After the initial implementation of a new DynaLoader dl_*.xs file you
+may need to edit or create ext/MODULE/MODULE.bs files (library bootstrap
+files) to reflect the needs of your platform and linking software.
+
+Refer to DynaLoader.pm, lib/ExtUtils/MakeMaker.pm and any existing
+ext/MODULE/MODULE.bs files for more information.
+
+Tim Bunce.
+August 1994
diff --git a/contrib/perl5/ext/DynaLoader/dl_aix.xs b/contrib/perl5/ext/DynaLoader/dl_aix.xs
new file mode 100644
index 0000000..ea50408
--- /dev/null
+++ b/contrib/perl5/ext/DynaLoader/dl_aix.xs
@@ -0,0 +1,670 @@
+/* dl_aix.xs
+ *
+ * Written: 8/31/94 by Wayne Scott (wscott@ichips.intel.com)
+ *
+ *  All I did was take Jens-Uwe Mager's libdl emulation library for
+ *  AIX and merged it with the dl_dlopen.xs file to create a dynamic library
+ *  package that works for AIX.
+ *
+ *  I did change all malloc's, free's, strdup's, calloc's to use the perl
+ *  equilvant.  I also removed some stuff we will not need.  Call fini()
+ *  on statup...   It can probably be trimmed more.
+ */
+
+/*
+ * @(#)dlfcn.c	1.5 revision of 93/02/14  20:14:17
+ * This is an unpublished work copyright (c) 1992 Helios Software GmbH
+ * 3000 Hannover 1, Germany
+ */
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#include <stdio.h>
+#include <errno.h>
+#include <string.h>
+#include <stdlib.h>
+#include <sys/types.h>
+#include <sys/ldr.h>
+#include <a.out.h>
+#include <ldfcn.h>
+
+/*
+ * AIX 4.3 does remove some useful definitions from ldfcn.h. Define
+ * these here to compensate for that lossage.
+ */
+#ifndef BEGINNING
+# define BEGINNING SEEK_SET
+#endif
+#ifndef FSEEK
+# define FSEEK(ldptr,o,p)	fseek(IOPTR(ldptr),(p==BEGINNING)?(OFFSET(ldptr) +o):o,p)
+#endif
+#ifndef FREAD
+# define FREAD(p,s,n,ldptr)	fread(p,s,n,IOPTR(ldptr))
+#endif
+
+/* If using PerlIO, redefine these macros from <ldfcn.h> */
+#ifdef USE_PERLIO
+#define FSEEK(ldptr,o,p)        PerlIO_seek(IOPTR(ldptr),(p==BEGINNING)?(OFFSET(ldptr)+o):o,p)
+#define FREAD(p,s,n,ldptr)      PerlIO_read(IOPTR(ldptr),p,s*n)
+#endif
+
+/*
+ * We simulate dlopen() et al. through a call to load. Because AIX has
+ * no call to find an exported symbol we read the loader section of the
+ * loaded module and build a list of exported symbols and their virtual
+ * address.
+ */
+
+typedef struct {
+	char		*name;		/* the symbols's name */
+	void		*addr;		/* its relocated virtual address */
+} Export, *ExportPtr;
+
+/*
+ * The void * handle returned from dlopen is actually a ModulePtr.
+ */
+typedef struct Module {
+	struct Module	*next;
+	char		*name;		/* module name for refcounting */
+	int		refCnt;		/* the number of references */
+	void		*entry;		/* entry point from load */
+	int		nExports;	/* the number of exports found */
+	ExportPtr	exports;	/* the array of exports */
+} Module, *ModulePtr;
+
+/*
+ * We keep a list of all loaded modules to be able to call the fini
+ * handlers at atexit() time.
+ */
+static ModulePtr modList;
+
+/*
+ * The last error from one of the dl* routines is kept in static
+ * variables here. Each error is returned only once to the caller.
+ */
+static char errbuf[BUFSIZ];
+static int errvalid;
+
+static void caterr(char *);
+static int readExports(ModulePtr);
+static void terminate(void);
+static void *findMain(void);
+
+static char *strerror_failed   = "(strerror failed)";
+static char *strerror_r_failed = "(strerror_r failed)";
+
+char *strerrorcat(char *str, int err) {
+    int strsiz = strlen(str);
+    int msgsiz;
+    char *msg;
+
+#ifdef USE_THREADS
+    char *buf = malloc(BUFSIZ);
+
+    if (buf == 0)
+      return 0;
+    if (strerror_r(err, buf, sizeof(buf)) == 0)
+      msg = buf;
+    else
+      msg = strerror_r_failed;
+    msgsiz = strlen(msg);
+    if (strsiz + msgsiz < BUFSIZ)
+      strcat(str, msg);
+    free(buf);
+#else
+    if ((msg = strerror(err)) == 0)
+      msg = strerror_failed;
+    msgsiz = strlen(msg);		/* Note msg = buf and free() above. */
+    if (strsiz + msgsiz < BUFSIZ)	/* Do not move this after #endif. */
+      strcat(str, msg);
+#endif
+
+    return str;
+}
+
+char *strerrorcpy(char *str, int err) {
+    int msgsiz;
+    char *msg;
+
+#ifdef USE_THREADS
+    char *buf = malloc(BUFSIZ);
+
+    if (buf == 0)
+      return 0;
+    if (strerror_r(err, buf, sizeof(buf)) == 0)
+      msg = buf;
+    else
+      msg = strerror_r_failed;
+    msgsiz = strlen(msg);
+    if (msgsiz < BUFSIZ)
+      strcpy(str, msg);
+    free(buf);
+#else
+    if ((msg = strerror(err)) == 0)
+      msg = strerror_failed;
+    msgsiz = strlen(msg);	/* Note msg = buf and free() above. */
+    if (msgsiz < BUFSIZ)	/* Do not move this after #endif. */
+      strcpy(str, msg);
+#endif
+
+    return str;
+}
+  
+/* ARGSUSED */
+void *dlopen(char *path, int mode)
+{
+	register ModulePtr mp;
+	static void *mainModule;
+
+	/*
+	 * Upon the first call register a terminate handler that will
+	 * close all libraries. Also get a reference to the main module
+	 * for use with loadbind.
+	 */
+	if (!mainModule) {
+		if ((mainModule = findMain()) == NULL)
+			return NULL;
+		atexit(terminate);
+	}
+	/*
+	 * Scan the list of modules if have the module already loaded.
+	 */
+	for (mp = modList; mp; mp = mp->next)
+		if (strcmp(mp->name, path) == 0) {
+			mp->refCnt++;
+			return mp;
+		}
+	Newz(1000,mp,1,Module);
+	if (mp == NULL) {
+		errvalid++;
+		strcpy(errbuf, "Newz: ");
+		strerrorcat(errbuf, errno);
+		return NULL;
+	}
+	
+	if ((mp->name = savepv(path)) == NULL) {
+		errvalid++;
+		strcpy(errbuf, "savepv: ");
+		strerrorcat(errbuf, errno);
+		safefree(mp);
+		return NULL;
+	}
+	/*
+	 * load should be declared load(const char *...). Thus we
+	 * cast the path to a normal char *. Ugly.
+	 */
+	if ((mp->entry = (void *)load((char *)path, L_NOAUTODEFER, NULL)) == NULL) {
+		safefree(mp->name);
+		safefree(mp);
+		errvalid++;
+		strcpy(errbuf, "dlopen: ");
+		strcat(errbuf, path);
+		strcat(errbuf, ": ");
+		/*
+		 * If AIX says the file is not executable, the error
+		 * can be further described by querying the loader about
+		 * the last error.
+		 */
+		if (errno == ENOEXEC) {
+			char *tmp[BUFSIZ/sizeof(char *)];
+			if (loadquery(L_GETMESSAGES, tmp, sizeof(tmp)) == -1)
+				strerrorcpy(errbuf, errno);
+			else {
+				char **p;
+				for (p = tmp; *p; p++)
+					caterr(*p);
+			}
+		} else
+			strerrorcat(errbuf, errno);
+		return NULL;
+	}
+	mp->refCnt = 1;
+	mp->next = modList;
+	modList = mp;
+	if (loadbind(0, mainModule, mp->entry) == -1) {
+		dlclose(mp);
+		errvalid++;
+		strcpy(errbuf, "loadbind: ");
+		strerrorcat(errbuf, errno);
+		return NULL;
+	}
+	if (readExports(mp) == -1) {
+		dlclose(mp);
+		return NULL;
+	}
+	return mp;
+}
+
+/*
+ * Attempt to decipher an AIX loader error message and append it
+ * to our static error message buffer.
+ */
+static void caterr(char *s)
+{
+	register char *p = s;
+
+	while (*p >= '0' && *p <= '9')
+		p++;
+	switch(atoi(s)) {
+	case L_ERROR_TOOMANY:
+		strcat(errbuf, "to many errors");
+		break;
+	case L_ERROR_NOLIB:
+		strcat(errbuf, "can't load library");
+		strcat(errbuf, p);
+		break;
+	case L_ERROR_UNDEF:
+		strcat(errbuf, "can't find symbol");
+		strcat(errbuf, p);
+		break;
+	case L_ERROR_RLDBAD:
+		strcat(errbuf, "bad RLD");
+		strcat(errbuf, p);
+		break;
+	case L_ERROR_FORMAT:
+		strcat(errbuf, "bad exec format in");
+		strcat(errbuf, p);
+		break;
+	case L_ERROR_ERRNO:
+		strerrorcat(errbuf, atoi(++p));
+		break;
+	default:
+		strcat(errbuf, s);
+		break;
+	}
+}
+
+void *dlsym(void *handle, const char *symbol)
+{
+	register ModulePtr mp = (ModulePtr)handle;
+	register ExportPtr ep;
+	register int i;
+
+	/*
+	 * Could speed up search, but I assume that one assigns
+	 * the result to function pointers anyways.
+	 */
+	for (ep = mp->exports, i = mp->nExports; i; i--, ep++)
+		if (strcmp(ep->name, symbol) == 0)
+			return ep->addr;
+	errvalid++;
+	strcpy(errbuf, "dlsym: undefined symbol ");
+	strcat(errbuf, symbol);
+	return NULL;
+}
+
+char *dlerror(void)
+{
+	if (errvalid) {
+		errvalid = 0;
+		return errbuf;
+	}
+	return NULL;
+}
+
+int dlclose(void *handle)
+{
+	register ModulePtr mp = (ModulePtr)handle;
+	int result;
+	register ModulePtr mp1;
+
+	if (--mp->refCnt > 0)
+		return 0;
+	result = unload(mp->entry);
+	if (result == -1) {
+		errvalid++;
+		strerrorcpy(errbuf, errno);
+	}
+	if (mp->exports) {
+		register ExportPtr ep;
+		register int i;
+		for (ep = mp->exports, i = mp->nExports; i; i--, ep++)
+			if (ep->name)
+				safefree(ep->name);
+		safefree(mp->exports);
+	}
+	if (mp == modList)
+		modList = mp->next;
+	else {
+		for (mp1 = modList; mp1; mp1 = mp1->next)
+			if (mp1->next == mp) {
+				mp1->next = mp->next;
+				break;
+			}
+	}
+	safefree(mp->name);
+	safefree(mp);
+	return result;
+}
+
+static void terminate(void)
+{
+	while (modList)
+		dlclose(modList);
+}
+
+/* Added by Wayne Scott 
+ * This is needed because the ldopen system call calls
+ * calloc to allocated a block of date.  The ldclose call calls free.
+ * Without this we get this system calloc and perl's free, resulting
+ * in a "Bad free" message.  This way we always use perl's malloc.
+ */
+void *calloc(size_t ne, size_t sz) 
+{
+  void *out;
+
+  out = (void *) safemalloc(ne*sz);
+  memzero(out, ne*sz);
+  return(out);
+}
+ 
+/*
+ * Build the export table from the XCOFF .loader section.
+ */
+static int readExports(ModulePtr mp)
+{
+	LDFILE *ldp = NULL;
+	SCNHDR sh;
+	LDHDR *lhp;
+	char *ldbuf;
+	LDSYM *ls;
+	int i;
+	ExportPtr ep;
+
+	if ((ldp = ldopen(mp->name, ldp)) == NULL) {
+		struct ld_info *lp;
+		char *buf;
+		int size = 4*1024;
+		if (errno != ENOENT) {
+			errvalid++;
+			strcpy(errbuf, "readExports: ");
+			strerrorcat(errbuf, errno);
+			return -1;
+		}
+		/*
+		 * The module might be loaded due to the LIBPATH
+		 * environment variable. Search for the loaded
+		 * module using L_GETINFO.
+		 */
+		if ((buf = safemalloc(size)) == NULL) {
+			errvalid++;
+			strcpy(errbuf, "readExports: ");
+			strerrorcat(errbuf, errno);
+			return -1;
+		}
+		while ((i = loadquery(L_GETINFO, buf, size)) == -1 && errno == ENOMEM) {
+			safefree(buf);
+			size += 4*1024;
+			if ((buf = safemalloc(size)) == NULL) {
+				errvalid++;
+				strcpy(errbuf, "readExports: ");
+				strerrorcat(errbuf, errno);
+				return -1;
+			}
+		}
+		if (i == -1) {
+			errvalid++;
+			strcpy(errbuf, "readExports: ");
+			strerrorcat(errbuf, errno);
+			safefree(buf);
+			return -1;
+		}
+		/*
+		 * Traverse the list of loaded modules. The entry point
+		 * returned by load() does actually point to the data
+		 * segment origin.
+		 */
+		lp = (struct ld_info *)buf;
+		while (lp) {
+			if (lp->ldinfo_dataorg == mp->entry) {
+				ldp = ldopen(lp->ldinfo_filename, ldp);
+				break;
+			}
+			if (lp->ldinfo_next == 0)
+				lp = NULL;
+			else
+				lp = (struct ld_info *)((char *)lp + lp->ldinfo_next);
+		}
+		safefree(buf);
+		if (!ldp) {
+			errvalid++;
+			strcpy(errbuf, "readExports: ");
+			strerrorcat(errbuf, errno);
+			return -1;
+		}
+	}
+	if (TYPE(ldp) != U802TOCMAGIC) {
+		errvalid++;
+		strcpy(errbuf, "readExports: bad magic");
+		while(ldclose(ldp) == FAILURE)
+			;
+		return -1;
+	}
+	if (ldnshread(ldp, _LOADER, &sh) != SUCCESS) {
+		errvalid++;
+		strcpy(errbuf, "readExports: cannot read loader section header");
+		while(ldclose(ldp) == FAILURE)
+			;
+		return -1;
+	}
+	/*
+	 * We read the complete loader section in one chunk, this makes
+	 * finding long symbol names residing in the string table easier.
+	 */
+	if ((ldbuf = (char *)safemalloc(sh.s_size)) == NULL) {
+		errvalid++;
+		strcpy(errbuf, "readExports: ");
+		strerrorcat(errbuf, errno);
+		while(ldclose(ldp) == FAILURE)
+			;
+		return -1;
+	}
+	if (FSEEK(ldp, sh.s_scnptr, BEGINNING) != OKFSEEK) {
+		errvalid++;
+		strcpy(errbuf, "readExports: cannot seek to loader section");
+		safefree(ldbuf);
+		while(ldclose(ldp) == FAILURE)
+			;
+		return -1;
+	}
+/* This first case is a hack, since it assumes that the 3rd parameter to
+   FREAD is 1. See the redefinition of FREAD above to see how this works. */
+#ifdef USE_PERLIO
+	if (FREAD(ldbuf, sh.s_size, 1, ldp) != sh.s_size) {
+#else
+	if (FREAD(ldbuf, sh.s_size, 1, ldp) != 1) {
+#endif
+		errvalid++;
+		strcpy(errbuf, "readExports: cannot read loader section");
+		safefree(ldbuf);
+		while(ldclose(ldp) == FAILURE)
+			;
+		return -1;
+	}
+	lhp = (LDHDR *)ldbuf;
+	ls = (LDSYM *)(ldbuf+LDHDRSZ);
+	/*
+	 * Count the number of exports to include in our export table.
+	 */
+	for (i = lhp->l_nsyms; i; i--, ls++) {
+		if (!LDR_EXPORT(*ls))
+			continue;
+		mp->nExports++;
+	}
+	Newz(1001, mp->exports, mp->nExports, Export);
+	if (mp->exports == NULL) {
+		errvalid++;
+		strcpy(errbuf, "readExports: ");
+		strerrorcat(errbuf, errno);
+		safefree(ldbuf);
+		while(ldclose(ldp) == FAILURE)
+			;
+		return -1;
+	}
+	/*
+	 * Fill in the export table. All entries are relative to
+	 * the entry point we got from load.
+	 */
+	ep = mp->exports;
+	ls = (LDSYM *)(ldbuf+LDHDRSZ);
+	for (i = lhp->l_nsyms; i; i--, ls++) {
+		char *symname;
+		if (!LDR_EXPORT(*ls))
+			continue;
+		if (ls->l_zeroes == 0)
+			symname = ls->l_offset+lhp->l_stoff+ldbuf;
+		else
+			symname = ls->l_name;
+		ep->name = savepv(symname);
+		ep->addr = (void *)((unsigned long)mp->entry + ls->l_value);
+		ep++;
+	}
+	safefree(ldbuf);
+	while(ldclose(ldp) == FAILURE)
+		;
+	return 0;
+}
+
+/*
+ * Find the main modules entry point. This is used as export pointer
+ * for loadbind() to be able to resolve references to the main part.
+ */
+static void * findMain(void)
+{
+	struct ld_info *lp;
+	char *buf;
+	int size = 4*1024;
+	int i;
+	void *ret;
+
+	if ((buf = safemalloc(size)) == NULL) {
+		errvalid++;
+		strcpy(errbuf, "findMain: ");
+		strerrorcat(errbuf, errno);
+		return NULL;
+	}
+	while ((i = loadquery(L_GETINFO, buf, size)) == -1 && errno == ENOMEM) {
+		safefree(buf);
+		size += 4*1024;
+		if ((buf = safemalloc(size)) == NULL) {
+			errvalid++;
+			strcpy(errbuf, "findMain: ");
+			strerrorcat(errbuf, errno);
+			return NULL;
+		}
+	}
+	if (i == -1) {
+		errvalid++;
+		strcpy(errbuf, "findMain: ");
+		strerrorcat(errbuf, errno);
+		safefree(buf);
+		return NULL;
+	}
+	/*
+	 * The first entry is the main module. The entry point
+	 * returned by load() does actually point to the data
+	 * segment origin.
+	 */
+	lp = (struct ld_info *)buf;
+	ret = lp->ldinfo_dataorg;
+	safefree(buf);
+	return ret;
+}
+
+/* dl_dlopen.xs
+ * 
+ * Platform:	SunOS/Solaris, possibly others which use dlopen.
+ * Author:	Paul Marquess (pmarquess@bfsec.bt.co.uk)
+ * Created:	10th July 1994
+ *
+ * Modified:
+ * 15th July 1994   - Added code to explicitly save any error messages.
+ * 3rd August 1994  - Upgraded to v3 spec.
+ * 9th August 1994  - Changed to use IV
+ * 10th August 1994 - Tim Bunce: Added RTLD_LAZY, switchable debugging,
+ *                    basic FreeBSD support, removed ClearError
+ *
+ */
+
+/* Porting notes:
+
+	see dl_dlopen.xs
+
+*/
+
+#include "dlutils.c"	/* SaveError() etc	*/
+
+
+static void
+dl_private_init()
+{
+    (void)dl_generic_private_init();
+}
+ 
+MODULE = DynaLoader     PACKAGE = DynaLoader
+
+BOOT:
+    (void)dl_private_init();
+
+
+void *
+dl_load_file(filename, flags=0)
+	char *	filename
+	int	flags
+	CODE:
+	DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,flags));
+	if (flags & 0x01)
+	    warn("Can't make loaded symbols global on this platform while loading %s",filename);
+	RETVAL = dlopen(filename, 1) ;
+	DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%x\n", RETVAL));
+	ST(0) = sv_newmortal() ;
+	if (RETVAL == NULL)
+	    SaveError("%s",dlerror()) ;
+	else
+	    sv_setiv( ST(0), (IV)RETVAL);
+
+
+void *
+dl_find_symbol(libhandle, symbolname)
+	void *		libhandle
+	char *		symbolname
+	CODE:
+	DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_find_symbol(handle=%x, symbol=%s)\n",
+		libhandle, symbolname));
+	RETVAL = dlsym(libhandle, symbolname);
+	DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "  symbolref = %x\n", RETVAL));
+	ST(0) = sv_newmortal() ;
+	if (RETVAL == NULL)
+	    SaveError("%s",dlerror()) ;
+	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(PerlIO_stderr(), "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/contrib/perl5/ext/DynaLoader/dl_cygwin32.xs b/contrib/perl5/ext/DynaLoader/dl_cygwin32.xs
new file mode 100644
index 0000000..2b75637
--- /dev/null
+++ b/contrib/perl5/ext/DynaLoader/dl_cygwin32.xs
@@ -0,0 +1,153 @@
+/* dl_cygwin32.xs
+ * 
+ * Platform:	Win32 (Windows NT/Windows 95)
+ * Author:	Wei-Yuen Tan (wyt@hip.com)
+ * Created:	A warm day in June, 1995
+ *
+ * Modified:
+ *    August 23rd 1995 - rewritten after losing everything when I
+ *                       wiped off my NT partition (eek!)
+ */
+/* Modified from the original dl_win32.xs to work with cygwin32
+   -John Cerney 3/26/97
+*/
+/* Porting notes:
+
+I merely took Paul's dl_dlopen.xs, took out extraneous stuff and
+replaced the appropriate SunOS calls with the corresponding Win32
+calls.
+
+*/
+
+#define WIN32_LEAN_AND_MEAN
+// Defines from windows needed for this function only. Can't include full
+//  Cygwin32 windows headers because of problems with CONTEXT redefinition
+//  Removed logic to tell not dynamically load static modules. It is assumed that all
+//   modules are dynamically built. This should be similar to the behavoir on sunOS.
+//   Leaving in the logic would have required changes to the standard perlmain.c code
+//
+// // Includes call a dll function to initialize it's impure_ptr.
+#include <stdio.h>
+void (*impure_setupptr)(struct _reent *);  // pointer to the impure_setup routine
+
+//#include <windows.h>
+#define LOAD_WITH_ALTERED_SEARCH_PATH	(8)
+typedef void *HANDLE;
+typedef HANDLE HINSTANCE;
+#define STDCALL     __attribute__ ((stdcall))
+typedef int STDCALL (*FARPROC)();
+
+HINSTANCE
+STDCALL
+LoadLibraryExA(
+	       char* lpLibFileName,
+	       HANDLE hFile,
+	       unsigned int dwFlags
+	       );
+unsigned int
+STDCALL
+GetLastError(
+	     void
+	     );
+FARPROC
+STDCALL
+GetProcAddress(
+	       HINSTANCE hModule,
+	       char* lpProcName
+	       );
+
+#include <string.h>
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#include "dlutils.c"	/* SaveError() etc	*/
+
+static void
+dl_private_init()
+{
+    (void)dl_generic_private_init();
+}
+
+
+MODULE = DynaLoader	PACKAGE = DynaLoader
+
+BOOT:
+    (void)dl_private_init();
+
+void *
+dl_load_file(filename,flags=0)
+    char *		filename
+    int			flags
+    PREINIT:
+    CODE:
+    DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n", filename));
+
+    RETVAL = (void*) LoadLibraryExA(filename, NULL, LOAD_WITH_ALTERED_SEARCH_PATH ) ;
+
+    DLDEBUG(2,fprintf(stderr," libref=%x\n", RETVAL));
+    ST(0) = sv_newmortal() ;
+    if (RETVAL == NULL){
+	SaveError("%d",GetLastError()) ;
+    }
+    else{
+	// setup the dll's impure_ptr:
+	impure_setupptr = GetProcAddress(RETVAL, "impure_setup");
+	if( impure_setupptr == NULL){
+		printf(
+    "Cygwin32 dynaloader error: could not load impure_setup symbol\n");
+		RETVAL = NULL;		
+	}
+	else{
+		// setup the DLLs impure_ptr:
+		(*impure_setupptr)(_impure_ptr);
+		sv_setiv( ST(0), (IV)RETVAL);
+	}
+   }
+	
+
+
+void *
+dl_find_symbol(libhandle, symbolname)
+    void *	libhandle
+    char *	symbolname
+    CODE:
+    DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n",
+	libhandle, symbolname));
+    RETVAL = (void*) GetProcAddress((HINSTANCE) libhandle, symbolname);
+    DLDEBUG(2,fprintf(stderr,"  symbolref = %x\n", RETVAL));
+    ST(0) = sv_newmortal() ;
+    if (RETVAL == NULL)
+	SaveError("%d",GetLastError()) ;
+    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,fprintf(stderr,"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/contrib/perl5/ext/DynaLoader/dl_dld.xs b/contrib/perl5/ext/DynaLoader/dl_dld.xs
new file mode 100644
index 0000000..2443ab0
--- /dev/null
+++ b/contrib/perl5/ext/DynaLoader/dl_dld.xs
@@ -0,0 +1,175 @@
+/*
+ *    Written 3/1/94, Robert Sanders <Robert.Sanders@linux.org>
+ *
+ * based upon the file "dl.c", which is
+ *    Copyright (c) 1994, Larry Wall
+ *
+ *    You may distribute under the terms of either the GNU General Public
+ *    License or the Artistic License, as specified in the README file.
+ *
+ * $Date: 1994/03/07 00:21:43 $
+ * $Source: /home/rsanders/src/perl5alpha6/RCS/dld_dl.c,v $
+ * $Revision: 1.4 $
+ * $State: Exp $
+ *
+ * $Log: dld_dl.c,v $
+ * Removed implicit link against libc.  1994/09/14 William Setzer.
+ *
+ * Integrated other DynaLoader changes. 1994/06/08 Tim Bunce.
+ *
+ * rewrote dl_load_file, misc updates.  1994/09/03 William Setzer.
+ *
+ * Revision 1.4  1994/03/07  00:21:43  rsanders
+ * added min symbol count for load_libs and switched order so system libs
+ * are loaded after app-specified libs.
+ *
+ * Revision 1.3  1994/03/05  01:17:26  rsanders
+ * added path searching.
+ *
+ * Revision 1.2  1994/03/05  00:52:39  rsanders
+ * added package-specified libraries.
+ *
+ * Revision 1.1  1994/03/05  00:33:40  rsanders
+ * Initial revision
+ *
+ *
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#include <dld.h>	/* GNU DLD header file */
+#include <unistd.h>
+
+#include "dlutils.c"	/* for SaveError() etc */
+
+static AV *dl_resolve_using   = Nullav;
+static AV *dl_require_symbols = Nullav;
+
+static void
+dl_private_init()
+{
+    int dlderr;
+    dl_generic_private_init();
+    dl_resolve_using   = perl_get_av("DynaLoader::dl_resolve_using",   0x4);
+    dl_require_symbols = perl_get_av("DynaLoader::dl_require_symbols", 0x4);
+#ifdef __linux__
+    dlderr = dld_init("/proc/self/exe");
+    if (dlderr) {
+#endif
+        dlderr = dld_init(dld_find_executable(PL_origargv[0]));
+        if (dlderr) {
+            char *msg = dld_strerror(dlderr);
+            SaveError("dld_init(%s) failed: %s", PL_origargv[0], msg);
+            DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "%s", LastError));
+        }
+#ifdef __linux__
+    }
+#endif
+}
+
+
+MODULE = DynaLoader     PACKAGE = DynaLoader
+
+BOOT:
+    (void)dl_private_init();
+
+
+char *
+dl_load_file(filename, flags=0)
+    char *	filename
+    int		flags
+    PREINIT:
+    int dlderr,x,max;
+    GV *gv;
+    CODE:
+    RETVAL = filename;
+    DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,flags));
+    if (flags & 0x01)
+	croak("Can't make loaded symbols global on this platform while loading %s",filename);
+    max = AvFILL(dl_require_symbols);
+    for (x = 0; x <= max; x++) {
+	char *sym = SvPVX(*av_fetch(dl_require_symbols, x, 0));
+	DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dld_create_ref(%s)\n", sym));
+	if (dlderr = dld_create_reference(sym)) {
+	    SaveError("dld_create_reference(%s): %s", sym,
+		      dld_strerror(dlderr));
+	    goto haverror;
+	}
+    }
+
+    DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dld_link(%s)\n", filename));
+    if (dlderr = dld_link(filename)) {
+	SaveError("dld_link(%s): %s", filename, dld_strerror(dlderr));
+	goto haverror;
+    }
+
+    max = AvFILL(dl_resolve_using);
+    for (x = 0; x <= max; x++) {
+	char *sym = SvPVX(*av_fetch(dl_resolve_using, x, 0));
+	DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dld_link(%s)\n", sym));
+	if (dlderr = dld_link(sym)) {
+	    SaveError("dld_link(%s): %s", sym, dld_strerror(dlderr));
+	    goto haverror;
+	}
+    }
+    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "libref=%s\n", RETVAL));
+haverror:
+    ST(0) = sv_newmortal() ;
+    if (dlderr == 0)
+	sv_setiv(ST(0), (IV)RETVAL);
+
+
+void *
+dl_find_symbol(libhandle, symbolname)
+    void *	libhandle
+    char *	symbolname
+    CODE:
+    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_find_symbol(handle=%x, symbol=%s)\n",
+	    libhandle, symbolname));
+    RETVAL = (void *)dld_get_func(symbolname);
+    /* if RETVAL==NULL we should try looking for a non-function symbol */
+    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "  symbolref = %x\n", RETVAL));
+    ST(0) = sv_newmortal() ;
+    if (RETVAL == NULL)
+	SaveError("dl_find_symbol: Unable to find '%s' symbol", symbolname) ;
+    else
+	sv_setiv(ST(0), (IV)RETVAL);
+
+
+void
+dl_undef_symbols()
+    PPCODE:
+    if (dld_undefined_sym_count) {
+	int x;
+	char **undef_syms = dld_list_undefined_sym();
+	EXTEND(SP, dld_undefined_sym_count);
+	for (x=0; x < dld_undefined_sym_count; x++)
+	    PUSHs(sv_2mortal(newSVpv(undef_syms[x]+1, 0)));
+	free(undef_syms);
+    }
+
+
+
+# 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(PerlIO_stderr(), "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/contrib/perl5/ext/DynaLoader/dl_dlopen.xs b/contrib/perl5/ext/DynaLoader/dl_dlopen.xs
new file mode 100644
index 0000000..2459205
--- /dev/null
+++ b/contrib/perl5/ext/DynaLoader/dl_dlopen.xs
@@ -0,0 +1,219 @@
+/* dl_dlopen.xs
+ * 
+ * Platform:	SunOS/Solaris, possibly others which use dlopen.
+ * Author:	Paul Marquess (pmarquess@bfsec.bt.co.uk)
+ * Created:	10th July 1994
+ *
+ * Modified:
+ * 15th July 1994   - Added code to explicitly save any error messages.
+ * 3rd August 1994  - Upgraded to v3 spec.
+ * 9th August 1994  - Changed to use IV
+ * 10th August 1994 - Tim Bunce: Added RTLD_LAZY, switchable debugging,
+ *                    basic FreeBSD support, removed ClearError
+ *
+ */
+
+/* Porting notes:
+
+
+   Definition of Sunos dynamic Linking functions
+   =============================================
+   In order to make this implementation easier to understand here is a
+   quick definition of the SunOS Dynamic Linking functions which are
+   used here.
+
+   dlopen
+   ------
+     void *
+     dlopen(path, mode)
+     char * path; 
+     int    mode;
+
+     This function takes the name of a dynamic object file and returns
+     a descriptor which can be used by dlsym later. It returns NULL on
+     error.
+
+     The mode parameter must be set to 1 for Solaris 1 and to
+     RTLD_LAZY (==2) on Solaris 2.
+
+
+   dlsym
+   ------
+     void *
+     dlsym(handle, symbol)
+     void * handle; 
+     char * symbol;
+
+     Takes the handle returned from dlopen and the name of a symbol to
+     get the address of. If the symbol was found a pointer is
+     returned.  It returns NULL on error. If DL_PREPEND_UNDERSCORE is
+     defined an underscore will be added to the start of symbol. This
+     is required on some platforms (freebsd).
+
+   dlerror
+   ------
+     char * dlerror()
+
+     Returns a null-terminated string which describes the last error
+     that occurred with either dlopen or dlsym. After each call to
+     dlerror the error message will be reset to a null pointer. The
+     SaveError function is used to save the error as soo as it happens.
+
+
+   Return Types
+   ============
+   In this implementation the two functions, dl_load_file &
+   dl_find_symbol, return void *. This is because the underlying SunOS
+   dynamic linker calls also return void *.  This is not necessarily
+   the case for all architectures. For example, some implementation
+   will want to return a char * for dl_load_file.
+
+   If void * is not appropriate for your architecture, you will have to
+   change the void * to whatever you require. If you are not certain of
+   how Perl handles C data types, I suggest you start by consulting	
+   Dean Roerich's Perl 5 API document. Also, have a look in the typemap 
+   file (in the ext directory) for a fairly comprehensive list of types 
+   that are already supported. If you are completely stuck, I suggest you
+   post a message to perl5-porters, comp.lang.perl.misc or if you are really 
+   desperate to me.
+
+   Remember when you are making any changes that the return value from 
+   dl_load_file is used as a parameter in the dl_find_symbol 
+   function. Also the return value from find_symbol is used as a parameter 
+   to install_xsub.
+
+
+   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 SunOS the function dlerror returns the error message 
+   associated with the last dynamic link error. As the SunOS dynamic 
+   linker functions dlopen & dlsym both return NULL on error every call 
+   to a SunOS dynamic link routine is coded like this
+
+	RETVAL = dlopen(filename, 1) ;
+	if (RETVAL == NULL)
+	    SaveError("%s",dlerror()) ;
+
+   Note that SaveError() takes a printf format string. Use a "%s" as
+   the first parameter if the error may contain and % characters.
+
+*/
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#ifdef I_DLFCN
+#include <dlfcn.h>	/* the dynamic linker include file for Sunos/Solaris */
+#else
+#include <nlist.h>
+#include <link.h>
+#endif
+
+#ifndef RTLD_LAZY
+# define RTLD_LAZY 1	/* Solaris 1 */
+#endif
+
+#ifndef HAS_DLERROR
+# ifdef __NetBSD__
+#  define dlerror() strerror(errno)
+# else
+#  define dlerror() "Unknown error - dlerror() not implemented"
+# endif
+#endif
+
+
+#include "dlutils.c"	/* SaveError() etc	*/
+
+
+static void
+dl_private_init()
+{
+    (void)dl_generic_private_init();
+}
+
+MODULE = DynaLoader	PACKAGE = DynaLoader
+
+BOOT:
+    (void)dl_private_init();
+
+
+void *
+dl_load_file(filename, flags=0)
+    char *	filename
+    int		flags
+    PREINIT:
+    int mode = RTLD_LAZY;
+    CODE:
+#ifdef RTLD_NOW
+    if (dl_nonlazy)
+	mode = RTLD_NOW;
+#endif
+    if (flags & 0x01)
+#ifdef RTLD_GLOBAL
+	mode |= RTLD_GLOBAL;
+#else
+	warn("Can't make loaded symbols global on this platform while loading %s",filename);
+#endif
+    DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,flags));
+    RETVAL = dlopen(filename, mode) ;
+    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%lx\n", (unsigned long) RETVAL));
+    ST(0) = sv_newmortal() ;
+    if (RETVAL == NULL)
+	SaveError("%s",dlerror()) ;
+    else
+	sv_setiv( ST(0), (IV)RETVAL);
+
+
+void *
+dl_find_symbol(libhandle, symbolname)
+    void *	libhandle
+    char *	symbolname
+    CODE:
+#ifdef DLSYM_NEEDS_UNDERSCORE
+    symbolname = form("_%s", symbolname);
+#endif
+    DLDEBUG(2, PerlIO_printf(PerlIO_stderr(),
+			     "dl_find_symbol(handle=%lx, symbol=%s)\n",
+			     (unsigned long) libhandle, symbolname));
+    RETVAL = dlsym(libhandle, symbolname);
+    DLDEBUG(2, PerlIO_printf(PerlIO_stderr(),
+			     "  symbolref = %lx\n", (unsigned long) RETVAL));
+    ST(0) = sv_newmortal() ;
+    if (RETVAL == NULL)
+	SaveError("%s",dlerror()) ;
+    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(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%lx)\n",
+		perl_name, (unsigned long) symref));
+    ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)_((CV *)))symref, filename)));
+
+
+char *
+dl_error()
+    CODE:
+    RETVAL = LastError ;
+    OUTPUT:
+    RETVAL
+
+# end.
diff --git a/contrib/perl5/ext/DynaLoader/dl_hpux.xs b/contrib/perl5/ext/DynaLoader/dl_hpux.xs
new file mode 100644
index 0000000..a82e0ea
--- /dev/null
+++ b/contrib/perl5/ext/DynaLoader/dl_hpux.xs
@@ -0,0 +1,157 @@
+/*
+ * Author: Jeff Okamoto (okamoto@corp.hp.com)
+ * Version: 2.1, 1995/1/25
+ */
+
+/* o Added BIND_VERBOSE to dl_nonlazy condition to add names of missing
+ *   symbols to stderr message on fatal error.
+ *
+ * o Added BIND_NONFATAL comment to default condition.
+ *
+ * Chuck Phillips (cdp@fc.hp.com)
+ * Version: 2.2, 1997/5/4 */
+
+#ifdef __hp9000s300
+#define magic hpux_magic
+#define MAGIC HPUX_MAGIC
+#endif
+
+#include <dl.h>
+#ifdef __hp9000s300
+#undef magic
+#undef MAGIC
+#endif
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+
+#include "dlutils.c"	/* for SaveError() etc */
+
+static AV *dl_resolve_using = Nullav;
+
+
+static void
+dl_private_init()
+{
+    (void)dl_generic_private_init();
+    dl_resolve_using = perl_get_av("DynaLoader::dl_resolve_using", 0x4);
+}
+
+MODULE = DynaLoader     PACKAGE = DynaLoader
+
+BOOT:
+    (void)dl_private_init();
+
+
+void *
+dl_load_file(filename, flags=0)
+    char *	filename
+    int		flags
+    PREINIT:
+    shl_t obj = NULL;
+    int	i, max, bind_type;
+    CODE:
+    DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,flags));
+    if (flags & 0x01)
+	warn("Can't make loaded symbols global on this platform while loading %s",filename);
+    if (dl_nonlazy) {
+      bind_type = BIND_IMMEDIATE|BIND_VERBOSE;
+    } else {
+      bind_type = BIND_DEFERRED;
+      /* For certain libraries, like DCE, deferred binding often causes run
+       * time problems.  Adding BIND_NONFATAL to BIND_IMMEDIATE still allows
+       * unresolved references in situations like this.  */
+      /* bind_type = BIND_IMMEDIATE|BIND_NONFATAL; */
+    }
+    /* BIND_NOSTART removed from bind_type because it causes the shared library's	*/
+    /* initialisers not to be run.  This causes problems with all of the static objects */
+    /* in the library.	   */
+#ifdef DEBUGGING
+    if (dl_debug)
+	bind_type |= BIND_VERBOSE;
+#endif /* DEBUGGING */
+
+    max = AvFILL(dl_resolve_using);
+    for (i = 0; i <= max; i++) {
+	char *sym = SvPVX(*av_fetch(dl_resolve_using, i, 0));
+	DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s) (dependent)\n", sym));
+	obj = shl_load(sym, bind_type, 0L);
+	if (obj == NULL) {
+	    goto end;
+	}
+    }
+
+    DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s): ", filename));
+    obj = shl_load(filename, bind_type, 0L);
+
+    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%x\n", obj));
+end:
+    ST(0) = sv_newmortal() ;
+    if (obj == NULL)
+        SaveError("%s",Strerror(errno));
+    else
+        sv_setiv( ST(0), (IV)obj);
+
+
+void *
+dl_find_symbol(libhandle, symbolname)
+    void *	libhandle
+    char *	symbolname
+    CODE:
+    shl_t obj = (shl_t) libhandle;
+    void *symaddr = NULL;
+    int status;
+#ifdef __hp9000s300
+    symbolname = form("_%s", symbolname);
+#endif
+    DLDEBUG(2, PerlIO_printf(PerlIO_stderr(),
+			     "dl_find_symbol(handle=%lx, symbol=%s)\n",
+			     (unsigned long) libhandle, symbolname));
+
+    ST(0) = sv_newmortal() ;
+    errno = 0;
+
+    status = shl_findsym(&obj, symbolname, TYPE_PROCEDURE, &symaddr);
+    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "  symbolref(PROCEDURE) = %x\n", symaddr));
+
+    if (status == -1 && errno == 0) {	/* try TYPE_DATA instead */
+	status = shl_findsym(&obj, symbolname, TYPE_DATA, &symaddr);
+	DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "  symbolref(DATA) = %x\n", symaddr));
+    }
+
+    if (status == -1) {
+	SaveError("%s",(errno) ? Strerror(errno) : "Symbol not found") ;
+    } else {
+	sv_setiv( ST(0), (IV)symaddr);
+    }
+
+
+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(PerlIO_stderr(), "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/contrib/perl5/ext/DynaLoader/dl_mpeix.xs b/contrib/perl5/ext/DynaLoader/dl_mpeix.xs
new file mode 100644
index 0000000..808c3b0
--- /dev/null
+++ b/contrib/perl5/ext/DynaLoader/dl_mpeix.xs
@@ -0,0 +1,128 @@
+/*
+ * Author:  Mark Klein (mklein@dis.com)
+ * Version: 2.1, 1996/07/25
+ * Version: 2.2, 1997/09/25 Mark Bixby (markb@cccd.edu)
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#ifdef __GNUC__
+extern void HPGETPROCPLABEL(    int    parms,
+                                char * procname,
+                                int  * plabel,
+                                int  * status,
+                                char * firstfile,
+                                int    casesensitive,
+                                int    symboltype,
+                                int  * datasize,
+                                int    position,
+                                int    searchpath,
+                                int    binding);
+#else
+#pragma intrinsic HPGETPROCPLABEL
+#endif
+#include "dlutils.c"    /* for SaveError() etc */
+
+typedef struct {
+  char  filename[PATH_MAX + 3];
+  } t_mpe_dld, *p_mpe_dld;
+
+static AV *dl_resolve_using = Nullav;
+
+static void
+dl_private_init()
+{
+    (void)dl_generic_private_init();
+    dl_resolve_using = perl_get_av("DynaLoader::dl_resolve_using", 0x4);
+}
+
+MODULE = DynaLoader     PACKAGE = DynaLoader
+
+BOOT:
+    (void)dl_private_init();
+
+void *
+dl_load_file(filename, flags=0)
+    char *      filename
+    int         flags
+    PREINIT:
+    char                buf[PATH_MAX + 3];
+    p_mpe_dld           obj = NULL;
+    int                 i;
+    CODE:
+    DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,
+flags));
+    if (flags & 0x01)
+        warn("Can't make loaded symbols global on this platform while loading %s
+",filename);
+    obj = (p_mpe_dld) safemalloc(sizeof(t_mpe_dld));
+    memzero(obj, sizeof(t_mpe_dld));
+    if (filename[0] == '.')
+        {
+        getcwd(buf,sizeof(buf));
+        sprintf(obj->filename,"$%s/%s$",buf,filename);
+        }
+    else
+        sprintf(obj->filename,"$%s$",filename);
+
+    DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," libref=%x\n", obj));
+
+    ST(0) = sv_newmortal() ;
+    if (obj == NULL)
+        SaveError("%s",Strerror(errno));
+    else
+        sv_setiv( ST(0), (IV)obj);
+
+void *
+dl_find_symbol(libhandle, symbolname)
+    void *      libhandle
+    char *      symbolname
+    CODE:
+    int       datalen;
+    p_mpe_dld obj = (p_mpe_dld) libhandle;
+    char      symname[PATH_MAX + 3];
+    void *    symaddr = NULL;
+    int       status;
+    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"dl_find_symbol(handle=%x, symbol=%s)\n",
+                libhandle, symbolname));
+    ST(0) = sv_newmortal() ;
+    errno = 0;
+
+    sprintf(symname, "$%s$", symbolname);
+    HPGETPROCPLABEL(8, symname, &symaddr, &status, obj->filename, 1,
+                    0, &datalen, 1, 0, 0);
+
+    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"  symbolref(PROCEDURE) = %x\n", symaddr));
+
+    if (status != 0) {
+        SaveError("%s",(errno) ? Strerror(errno) : "Symbol not found") ;
+    } else {
+        sv_setiv( ST(0), (IV)symaddr);
+    }
+
+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(PerlIO_stderr(),"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/contrib/perl5/ext/DynaLoader/dl_next.xs b/contrib/perl5/ext/DynaLoader/dl_next.xs
new file mode 100644
index 0000000..2b547f0
--- /dev/null
+++ b/contrib/perl5/ext/DynaLoader/dl_next.xs
@@ -0,0 +1,303 @@
+/* dl_next.xs
+ * 
+ * Platform:	NeXT NS 3.2
+ * Author:	Anno Siegel (siegel@zrz.TU-Berlin.DE)
+ * Based on:	dl_dlopen.xs by Paul Marquess
+ * Created:	Aug 15th, 1994
+ *
+ */
+
+/*
+    And Gandalf said: 'Many folk like to know beforehand what is to
+    be set on the table; but those who have laboured to prepare the
+    feast like to keep their secret; for wonder makes the words of
+    praise louder.'
+*/
+
+/* Porting notes:
+
+dl_next.xs is itself a port from dl_dlopen.xs by Paul Marquess.  It
+should not be used as a base for further ports though it may be used
+as an example for how dl_dlopen.xs can be ported to other platforms.
+
+The method used here is just to supply the sun style dlopen etc.
+functions in terms of NeXTs rld_*.  The xs code proper is unchanged
+from Paul's original.
+
+The port could use some streamlining.  For one, error handling could
+be simplified.
+
+Anno Siegel
+
+*/
+
+#if NS_TARGET_MAJOR >= 4
+#else
+/* include these before perl headers */
+#include <mach-o/rld.h>
+#include <streams/streams.h>
+#endif
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#define DL_LOADONCEONLY
+
+#include "dlutils.c"	/* SaveError() etc	*/
+
+
+static char * dl_last_error = (char *) 0;
+static AV *dl_resolve_using = Nullav;
+
+static char *dlerror()
+{
+    return dl_last_error;
+}
+
+int dlclose(handle) /* stub only */
+void *handle;
+{
+    return 0;
+}
+
+#if NS_TARGET_MAJOR >= 4
+#import <mach-o/dyld.h>
+
+enum dyldErrorSource
+{
+    OFImage,
+};
+
+static void TranslateError
+    (const char *path, enum dyldErrorSource type, int number)
+{
+    char *error;
+    unsigned int index;
+    static char *OFIErrorStrings[] =
+    {
+	"%s(%d): Object Image Load Failure\n",
+	"%s(%d): Object Image Load Success\n",
+	"%s(%d): Not an recognisable object file\n",
+	"%s(%d): No valid architecture\n",
+	"%s(%d): Object image has an invalid format\n",
+	"%s(%d): Invalid access (permissions?)\n",
+	"%s(%d): Unknown error code from NSCreateObjectFileImageFromFile\n",
+    };
+#define NUM_OFI_ERRORS (sizeof(OFIErrorStrings) / sizeof(OFIErrorStrings[0]))
+
+    switch (type)
+    {
+    case OFImage:
+	index = number;
+	if (index > NUM_OFI_ERRORS - 1)
+	    index = NUM_OFI_ERRORS - 1;
+	error = form(OFIErrorStrings[index], path, number);
+	break;
+
+    default:
+	error = form("%s(%d): Totally unknown error type %d\n",
+		     path, number, type);
+	break;
+    }
+    Safefree(dl_last_error);
+    dl_last_error = savepv(error);
+}
+
+static char *dlopen(char *path, int mode /* mode is ignored */)
+{
+    int dyld_result;
+    NSObjectFileImage ofile;
+    NSModule handle = NULL;
+
+    dyld_result = NSCreateObjectFileImageFromFile(path, &ofile);
+    if (dyld_result != NSObjectFileImageSuccess)
+	TranslateError(path, OFImage, dyld_result);
+    else
+    {
+    	// NSLinkModule will cause the run to abort on any link error's
+	// not very friendly but the error recovery functionality is limited.
+	handle = NSLinkModule(ofile, path, TRUE);
+    }
+    
+    return handle;
+}
+
+void *
+dlsym(handle, symbol)
+void *handle;
+char *symbol;
+{
+    void *addr;
+
+    if (NSIsSymbolNameDefined(symbol))
+	addr = NSAddressOfSymbol(NSLookupAndBindSymbol(symbol));
+    else
+    	addr = NULL;
+
+    return addr;
+}
+
+#else /* NS_TARGET_MAJOR <= 3 */
+
+static NXStream *OpenError(void)
+{
+    return NXOpenMemory( (char *) 0, 0, NX_WRITEONLY);
+}
+
+static void TransferError(NXStream *s)
+{
+    char *buffer;
+    int len, maxlen;
+
+    if ( dl_last_error ) {
+        Safefree(dl_last_error);
+    }
+    NXGetMemoryBuffer(s, &buffer, &len, &maxlen);
+    New(1097, dl_last_error, len, char);
+    strcpy(dl_last_error, buffer);
+}
+
+static void CloseError(NXStream *s)
+{
+    if ( s ) {
+      NXCloseMemory( s, NX_FREEBUFFER);
+    }
+}
+
+static char *dlopen(char *path, int mode /* mode is ignored */)
+{
+    int rld_success;
+    NXStream *nxerr;
+    I32 i, psize;
+    char *result;
+    char **p;
+	
+    /* Do not load what is already loaded into this process */
+    if (hv_fetch(dl_loaded_files, path, strlen(path), 0))
+	return path;
+
+    nxerr = OpenError();
+    psize = AvFILL(dl_resolve_using) + 3;
+    p = (char **) safemalloc(psize * sizeof(char*));
+    p[0] = path;
+    for(i=1; i<psize-1; i++) {
+	p[i] = SvPVx(*av_fetch(dl_resolve_using, i-1, TRUE), PL_na);
+    }
+    p[psize-1] = 0;
+    rld_success = rld_load(nxerr, (struct mach_header **)0, p,
+			    (const char *) 0);
+    safefree((char*) p);
+    if (rld_success) {
+	result = path;
+	/* prevent multiple loads of same file into same process */
+	hv_store(dl_loaded_files, path, strlen(path), &PL_sv_yes, 0);
+    } else {
+	TransferError(nxerr);
+	result = (char*) 0;
+    }
+    CloseError(nxerr);
+    return result;
+}
+
+void *
+dlsym(handle, symbol)
+void *handle;
+char *symbol;
+{
+    NXStream	*nxerr = OpenError();
+    unsigned long	symref = 0;
+
+    if (!rld_lookup(nxerr, form("_%s", symbol), &symref))
+	TransferError(nxerr);
+    CloseError(nxerr);
+    return (void*) symref;
+}
+
+#endif /* NS_TARGET_MAJOR >= 4 */
+
+
+/* ----- code from dl_dlopen.xs below here ----- */
+
+
+static void
+dl_private_init()
+{
+    (void)dl_generic_private_init();
+    dl_resolve_using = perl_get_av("DynaLoader::dl_resolve_using", 0x4);
+}
+ 
+MODULE = DynaLoader     PACKAGE = DynaLoader
+
+BOOT:
+    (void)dl_private_init();
+
+
+
+void *
+dl_load_file(filename, flags=0)
+    char *	filename
+    int		flags
+    PREINIT:
+    int mode = 1;
+    CODE:
+    DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,flags));
+    if (flags & 0x01)
+	warn("Can't make loaded symbols global on this platform while loading %s",filename);
+    RETVAL = dlopen(filename, mode) ;
+    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%x\n", RETVAL));
+    ST(0) = sv_newmortal() ;
+    if (RETVAL == NULL)
+	SaveError("%s",dlerror()) ;
+    else
+	sv_setiv( ST(0), (IV)RETVAL);
+
+
+void *
+dl_find_symbol(libhandle, symbolname)
+    void *		libhandle
+    char *		symbolname
+    CODE:
+#if NS_TARGET_MAJOR >= 4
+    symbolname = form("_%s", symbolname);
+#endif
+    DLDEBUG(2, PerlIO_printf(PerlIO_stderr(),
+			     "dl_find_symbol(handle=%lx, symbol=%s)\n",
+			     (unsigned long) libhandle, symbolname));
+    RETVAL = dlsym(libhandle, symbolname);
+    DLDEBUG(2, PerlIO_printf(PerlIO_stderr(),
+			     "  symbolref = %lx\n", (unsigned long) RETVAL));
+    ST(0) = sv_newmortal() ;
+    if (RETVAL == NULL)
+	SaveError("%s",dlerror()) ;
+    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(PerlIO_stderr(), "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/contrib/perl5/ext/DynaLoader/dl_none.xs b/contrib/perl5/ext/DynaLoader/dl_none.xs
new file mode 100644
index 0000000..5a193e4
--- /dev/null
+++ b/contrib/perl5/ext/DynaLoader/dl_none.xs
@@ -0,0 +1,19 @@
+/* dl_none.xs
+ * 
+ * Stubs for platforms that do not support dynamic linking
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+MODULE = DynaLoader	PACKAGE = DynaLoader
+
+char *
+dl_error()
+    CODE:
+    RETVAL = "Not implemented";
+    OUTPUT:
+    RETVAL
+
+# end.
diff --git a/contrib/perl5/ext/DynaLoader/dl_vms.xs b/contrib/perl5/ext/DynaLoader/dl_vms.xs
new file mode 100644
index 0000000..974fd58
--- /dev/null
+++ b/contrib/perl5/ext/DynaLoader/dl_vms.xs
@@ -0,0 +1,356 @@
+/* dl_vms.xs
+ * 
+ * Platform:  OpenVMS, VAX or AXP
+ * Author:    Charles Bailey  bailey@genetics.upenn.edu
+ * Revised:   12-Dec-1994
+ *
+ *                           Implementation Note
+ *     This section is added as an aid to users and DynaLoader developers, in
+ * order to clarify the process of dynamic linking under VMS.
+ *     dl_vms.xs uses the supported VMS dynamic linking call, which allows
+ * a running program to map an arbitrary file of executable code and call
+ * routines within that file.  This is done via the VMS RTL routine
+ * lib$find_image_symbol, whose calling sequence is as follows:
+ *   status = lib$find_image_symbol(imgname,symname,symval,defspec);
+ *   where
+ *     status  = a standard VMS status value (unsigned long int)
+ *     imgname = a fixed-length string descriptor, passed by
+ *               reference, containing the NAME ONLY of the image
+ *               file to be mapped.  An attempt will be made to
+ *               translate this string as a logical name, so it may
+ *               not contain any characters which are not allowed in
+ *               logical names.  If no translation is found, imgname
+ *               is used directly as the name of the image file.
+ *     symname = a fixed-length string descriptor, passed by
+ *               reference, containing the name of the routine
+ *               to be located.
+ *     symval  = an unsigned long int, passed by reference, into
+ *               which is written the entry point address of the
+ *               routine whose name is specified in symname.
+ *     defspec = a fixed-length string descriptor, passed by
+ *               reference, containing a default file specification
+ *               whichis used to fill in any missing parts of the
+ *               image file specification after the imgname argument
+ *               is processed.
+ * In order to accommodate the handling of the imgname argument, the routine
+ * dl_expandspec() is provided for use by perl code (e.g. dl_findfile)
+ * which wants to see what image file lib$find_image_symbol would use if
+ * it were passed a given file specification.  The file specification passed
+ * to dl_expandspec() and dl_load_file() can be partial or complete, and can
+ * use VMS or Unix syntax; these routines perform the necessary conversions.
+ *    In general, writers of perl extensions need only conform to the
+ * procedures set out in the DynaLoader documentation, and let the details
+ * be taken care of by the routines here and in DynaLoader.pm.  If anyone
+ * comes across any incompatibilities, please let me know.  Thanks.
+ *
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#include "dlutils.c"    /* dl_debug, LastError; SaveError not used  */
+
+static AV *dl_require_symbols = Nullav;
+
+/* N.B.:
+ * dl_debug and LastError are static vars; you'll need to deal
+ * with them appropriately if you need context independence
+ */
+
+#include <descrip.h>
+#include <fscndef.h>
+#include <lib$routines.h>
+#include <rms.h>
+#include <ssdef.h>
+#include <starlet.h>
+
+typedef unsigned long int vmssts;
+
+struct libref {
+  struct dsc$descriptor_s name;
+  struct dsc$descriptor_s defspec;
+};
+
+/* Static data for dl_expand_filespec() - This is static to save
+ * initialization on each call; if you need context-independence,
+ * just make these auto variables in dl_expandspec() and dl_load_file()
+ */
+static char dlesa[NAM$C_MAXRSS], dlrsa[NAM$C_MAXRSS];
+static struct FAB dlfab;
+static struct NAM dlnam;
+
+/* $PutMsg action routine - records error message in LastError */
+static vmssts
+copy_errmsg(msg,unused)
+    struct dsc$descriptor_s *   msg;
+    vmssts  unused;
+{
+    if (*(msg->dsc$a_pointer) == '%') { /* first line */
+      if (LastError)
+        strncpy((LastError = saferealloc(LastError,msg->dsc$w_length+1)),
+                 msg->dsc$a_pointer, msg->dsc$w_length);
+      else
+        strncpy((LastError = safemalloc(msg->dsc$w_length+1)),
+                 msg->dsc$a_pointer, msg->dsc$w_length);
+      LastError[msg->dsc$w_length] = '\0';
+    }
+    else { /* continuation line */
+      int errlen = strlen(LastError);
+      LastError = saferealloc(LastError, errlen + msg->dsc$w_length + 2);
+      LastError[errlen] = '\n';  LastError[errlen+1] = '\0';
+      strncat(LastError, msg->dsc$a_pointer, msg->dsc$w_length);
+      LastError[errlen+msg->dsc$w_length+1] = '\0';
+    }
+    return 0;
+}
+
+/* Use $PutMsg to retrieve error message for failure status code */
+static void
+dl_set_error(sts,stv)
+    vmssts  sts;
+    vmssts  stv;
+{
+    vmssts vec[3];
+
+    vec[0] = stv ? 2 : 1;
+    vec[1] = sts;  vec[2] = stv;
+    _ckvmssts(sys$putmsg(vec,copy_errmsg,0,0));
+}
+
+static unsigned int
+findsym_handler(void *sig, void *mech)
+{
+    unsigned long int myvec[8],args, *usig = (unsigned long int *) sig;
+    /* Be paranoid and assume signal vector passed in might be readonly */
+    myvec[0] = args = usig[0] > 10 ? 9 : usig[0] - 1;
+    while (--args) myvec[args] = usig[args];
+    _ckvmssts(sys$putmsg(myvec,copy_errmsg,0,0));
+    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "findsym_handler: received\n\t%s\n",LastError));
+    return SS$_CONTINUE;
+}
+
+/* wrapper for lib$find_image_symbol, so signalled errors can be saved
+ * for dl_error and then returned */
+static unsigned long int
+my_find_image_symbol(struct dsc$descriptor_s *imgname,
+                     struct dsc$descriptor_s *symname,
+                     void (**entry)(),
+                     struct dsc$descriptor_s *defspec)
+{
+  unsigned long int retsts;
+  VAXC$ESTABLISH(findsym_handler);
+  retsts = lib$find_image_symbol(imgname,symname,entry,defspec);
+  return retsts;
+}
+
+
+static void
+dl_private_init()
+{
+    dl_generic_private_init();
+    dl_require_symbols = perl_get_av("DynaLoader::dl_require_symbols", 0x4);
+    /* Set up the static control blocks for dl_expand_filespec() */
+    dlfab = cc$rms_fab;
+    dlnam = cc$rms_nam;
+    dlfab.fab$l_nam = &dlnam;
+    dlnam.nam$l_esa = dlesa;
+    dlnam.nam$b_ess = sizeof dlesa;
+    dlnam.nam$l_rsa = dlrsa;
+    dlnam.nam$b_rss = sizeof dlrsa;
+}
+MODULE = DynaLoader PACKAGE = DynaLoader
+
+BOOT:
+    (void)dl_private_init();
+
+void
+dl_expandspec(filespec)
+    char *	filespec
+    CODE:
+    char vmsspec[NAM$C_MAXRSS], defspec[NAM$C_MAXRSS];
+    size_t deflen;
+    vmssts sts;
+
+    tovmsspec(filespec,vmsspec);
+    dlfab.fab$l_fna = vmsspec;
+    dlfab.fab$b_fns = strlen(vmsspec);
+    dlfab.fab$l_dna = 0;
+    dlfab.fab$b_dns = 0;
+    DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_expand_filespec(%s):\n",vmsspec));
+    /* On the first pass, just parse the specification string */
+    dlnam.nam$b_nop = NAM$M_SYNCHK;
+    sts = sys$parse(&dlfab);
+    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tSYNCHK sys$parse = %d\n",sts));
+    if (!(sts & 1)) {
+      dl_set_error(dlfab.fab$l_sts,dlfab.fab$l_stv);
+      ST(0) = &PL_sv_undef;
+    }
+    else {
+      /* Now set up a default spec - everything but the name */
+      deflen = dlnam.nam$l_name - dlesa;
+      memcpy(defspec,dlesa,deflen);
+      memcpy(defspec+deflen,dlnam.nam$l_type,
+             dlnam.nam$b_type + dlnam.nam$b_ver);
+      deflen += dlnam.nam$b_type + dlnam.nam$b_ver;
+      memcpy(vmsspec,dlnam.nam$l_name,dlnam.nam$b_name);
+      DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tsplit filespec: name = %.*s, default = %.*s\n",
+                        dlnam.nam$b_name,vmsspec,deflen,defspec));
+      /* . . . and go back to expand it */
+      dlnam.nam$b_nop = 0;
+      dlfab.fab$l_dna = defspec;
+      dlfab.fab$b_dns = deflen;
+      dlfab.fab$b_fns = dlnam.nam$b_name;
+      sts = sys$parse(&dlfab);
+      DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tname/default sys$parse = %d\n",sts));
+      if (!(sts & 1)) {
+        dl_set_error(dlfab.fab$l_sts,dlfab.fab$l_stv);
+        ST(0) = &PL_sv_undef;
+      }
+      else {
+        /* Now find the actual file */
+        sts = sys$search(&dlfab);
+        DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tsys$search = %d\n",sts));
+        if (!(sts & 1)) {
+          dl_set_error(dlfab.fab$l_sts,dlfab.fab$l_stv);
+          ST(0) = &PL_sv_undef;
+        }
+        else {
+          ST(0) = sv_2mortal(newSVpv(dlnam.nam$l_rsa,dlnam.nam$b_rsl));
+          DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "\tresult = \\%.*s\\\n",
+                            dlnam.nam$b_rsl,dlnam.nam$l_rsa));
+        }
+      }
+    }
+
+void
+dl_load_file(filespec, flags)
+    char *	filespec
+    int		flags
+    PREINIT:
+    char vmsspec[NAM$C_MAXRSS];
+    SV *reqSV, **reqSVhndl;
+    STRLEN deflen;
+    struct dsc$descriptor_s
+      specdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0},
+      symdsc  = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
+    struct fscnlst {
+      unsigned short int len;
+      unsigned short int code;
+      char *string;
+    }  namlst[2] = {{0,FSCN$_NAME,0},{0,0,0}};
+    struct libref *dlptr;
+    vmssts sts, failed = 0;
+    void (*entry)();
+    CODE:
+
+    DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filespec,flags));
+    specdsc.dsc$a_pointer = tovmsspec(filespec,vmsspec);
+    specdsc.dsc$w_length = strlen(specdsc.dsc$a_pointer);
+    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tVMS-ified filespec is %s\n",
+                      specdsc.dsc$a_pointer));
+    New(1399,dlptr,1,struct libref);
+    dlptr->name.dsc$b_dtype = dlptr->defspec.dsc$b_dtype = DSC$K_DTYPE_T;
+    dlptr->name.dsc$b_class = dlptr->defspec.dsc$b_class = DSC$K_CLASS_S;
+    sts = sys$filescan(&specdsc,namlst,0);
+    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tsys$filescan: returns %d, name is %.*s\n",
+                      sts,namlst[0].len,namlst[0].string));
+    if (!(sts & 1)) {
+      failed = 1;
+      dl_set_error(sts,0);
+    }
+    else {
+      dlptr->name.dsc$w_length = namlst[0].len;
+      dlptr->name.dsc$a_pointer = savepvn(namlst[0].string,namlst[0].len);
+      dlptr->defspec.dsc$w_length = specdsc.dsc$w_length - namlst[0].len;
+      New(1097, dlptr->defspec.dsc$a_pointer, dlptr->defspec.dsc$w_length + 1, char);
+      deflen = namlst[0].string - specdsc.dsc$a_pointer; 
+      memcpy(dlptr->defspec.dsc$a_pointer,specdsc.dsc$a_pointer,deflen);
+      memcpy(dlptr->defspec.dsc$a_pointer + deflen,
+             namlst[0].string + namlst[0].len,
+             dlptr->defspec.dsc$w_length - deflen);
+      DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tlibref = name: %s, defspec: %.*s\n",
+                        dlptr->name.dsc$a_pointer,
+                        dlptr->defspec.dsc$w_length,
+                        dlptr->defspec.dsc$a_pointer));
+      if (!(reqSVhndl = av_fetch(dl_require_symbols,0,FALSE)) || !(reqSV = *reqSVhndl)) {
+        DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\t@dl_require_symbols empty, returning untested libref\n"));
+      }
+      else {
+        symdsc.dsc$w_length = SvCUR(reqSV);
+        symdsc.dsc$a_pointer = SvPVX(reqSV);
+        DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\t$dl_require_symbols[0] = %.*s\n",
+                          symdsc.dsc$w_length, symdsc.dsc$a_pointer));
+        sts = my_find_image_symbol(&(dlptr->name),&symdsc,
+                                    &entry,&(dlptr->defspec));
+        DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tlib$find_image_symbol returns %d\n",sts));
+        if (!(sts&1)) {
+          failed = 1;
+          dl_set_error(sts,0);
+        }
+      }
+    }
+
+    if (failed) {
+      Safefree(dlptr->name.dsc$a_pointer);
+      Safefree(dlptr->defspec.dsc$a_pointer);
+      Safefree(dlptr);
+      ST(0) = &PL_sv_undef;
+    }
+    else {
+      ST(0) = sv_2mortal(newSViv((IV) dlptr));
+    }
+
+
+void
+dl_find_symbol(librefptr,symname)
+    void *	librefptr
+    SV *	symname
+    CODE:
+    struct libref thislib = *((struct libref *)librefptr);
+    struct dsc$descriptor_s
+      symdsc = {SvCUR(symname),DSC$K_DTYPE_T,DSC$K_CLASS_S,SvPVX(symname)};
+    void (*entry)();
+    vmssts sts;
+
+    DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_find_dymbol(%.*s,%.*s):\n",
+                      thislib.name.dsc$w_length, thislib.name.dsc$a_pointer,
+                      symdsc.dsc$w_length,symdsc.dsc$a_pointer));
+    sts = my_find_image_symbol(&(thislib.name),&symdsc,
+                               &entry,&(thislib.defspec));
+    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tlib$find_image_symbol returns %d\n",sts));
+    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tentry point is %d\n",
+                      (unsigned long int) entry));
+    if (!(sts & 1)) {
+      /* error message already saved by findsym_handler */
+      ST(0) = &PL_sv_undef;
+    }
+    else ST(0) = sv_2mortal(newSViv((IV) entry));
+
+
+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(PerlIO_stderr(), "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/contrib/perl5/ext/DynaLoader/dlutils.c b/contrib/perl5/ext/DynaLoader/dlutils.c
new file mode 100644
index 0000000..bfa1f78
--- /dev/null
+++ b/contrib/perl5/ext/DynaLoader/dlutils.c
@@ -0,0 +1,72 @@
+/* dlutils.c - handy functions and definitions for dl_*.xs files
+ *
+ * Currently this file is simply #included into dl_*.xs/.c files.
+ * It should really be split into a dlutils.h and dlutils.c
+ *
+ */
+
+
+/* pointer to allocated memory for last error message */
+static char *LastError  = (char*)NULL;
+
+/* flag for immediate rather than lazy linking (spots unresolved symbol) */
+static int dl_nonlazy = 0;
+
+#ifdef DL_LOADONCEONLY
+static HV *dl_loaded_files = Nullhv;	/* only needed on a few systems */
+#endif
+
+
+#ifdef DEBUGGING
+static int dl_debug = 0;	/* value copied from $DynaLoader::dl_error */
+#define DLDEBUG(level,code)	if (dl_debug>=level) { code; }
+#else
+#define DLDEBUG(level,code)
+#endif
+
+
+static void
+dl_generic_private_init(CPERLarg)	/* called by dl_*.xs dl_private_init() */
+{
+    char *perl_dl_nonlazy;
+#ifdef DEBUGGING
+    dl_debug = SvIV( perl_get_sv("DynaLoader::dl_debug", 0x04) );
+#endif
+    if ( (perl_dl_nonlazy = getenv("PERL_DL_NONLAZY")) != NULL )
+	dl_nonlazy = atoi(perl_dl_nonlazy);
+    if (dl_nonlazy)
+	DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "DynaLoader bind mode is 'non-lazy'\n"));
+#ifdef DL_LOADONCEONLY
+    if (!dl_loaded_files)
+	dl_loaded_files = newHV(); /* provide cache for dl_*.xs if needed */
+#endif
+}
+
+
+/* SaveError() takes printf style args and saves the result in LastError */
+static void
+SaveError(CPERLarg_ char* pat, ...)
+{
+    va_list args;
+    char *message;
+    int len;
+
+    /* This code is based on croak/warn, see mess() in util.c */
+
+    va_start(args, pat);
+    message = mess(pat, &args);
+    va_end(args);
+
+    len = strlen(message) + 1 ;	/* include terminating null char */
+
+    /* Allocate some memory for the error message */
+    if (LastError)
+        LastError = (char*)saferealloc(LastError, len) ;
+    else
+        LastError = (char *) safemalloc(len) ;
+
+    /* Copy message into LastError (including terminating null char)	*/
+    strncpy(LastError, message, len) ;
+    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "DynaLoader: stored error msg '%s'\n",LastError));
+}
+
diff --git a/contrib/perl5/ext/Errno/ChangeLog b/contrib/perl5/ext/Errno/ChangeLog
new file mode 100644
index 0000000..2bfa003
--- /dev/null
+++ b/contrib/perl5/ext/Errno/ChangeLog
@@ -0,0 +1,50 @@
+Change 170 on 1998/07/05 by <gbarr@pobox.com> (Graham Barr)
+
+	Fixed three problems reported by Hans Mulder for NeXT
+	
+	- Errno_pm.PL does not recognize #define lines because they have
+	  whitespace before the '#'.  ANSI does not allow that in portable
+	  code; that didn't stop the author of NeXT's <errno.h>.
+	
+	- Cpp output lines look like this:	#1 "errno.c"
+	  Errno_pm.PL does not recognize that format; it wants whitespace
+	  before the line number.
+	
+	- Cpp does a syntax check on files with names ending in ".c"; it
+	  reports fatal errors on input lines like:	"ENOSYS" [[ENOSYS]]
+	  Workaround: use $Config{cppstdin}, like Errno 1.04 did.
+
+Change 160 on 1998/06/27 by <gbarr@pobox.com> (Graham Barr)
+
+	- Added patch from Sarathy to support Win32
+	- Changed use of $Config{cpp} to $Config{cpprun} as suggested by
+	  Tom Horsley
+
+Change 159 on 1998/06/27 by <gbarr@pobox.com> (Graham Barr)
+
+	- Changed to use cpp to locate required files
+	- Moved dummy Errno.pm file into d/
+	- Added support for VMS
+
+Change 158 on 1998/06/27 by <gbarr@pobox.com> (Graham Barr)
+
+	Rename errno.pl to Errno_pm.PL
+
+Change 146 on 1998/05/31 by <gbarr@pobox.com> (Graham Barr)
+
+	Added ChangeLog to MANIFEST
+
+Change 140 on 1998/05/23 by <gbarr@pobox.com> (Graham Barr)
+
+	Fix type in errno.pl
+
+Change 139 on 1998/05/23 by <gbarr@pobox.com> (Graham Barr)
+
+	Moved code to generate Errno.pm into errno.pl
+
+Change 136 on 1998/05/19 by <gbarr@pobox.com> (Graham Barr)
+
+	Changed to use cpp to locate constants
+	
+	Added t/errno.t
+
diff --git a/contrib/perl5/ext/Errno/Errno_pm.PL b/contrib/perl5/ext/Errno/Errno_pm.PL
new file mode 100644
index 0000000..f4d5020
--- /dev/null
+++ b/contrib/perl5/ext/Errno/Errno_pm.PL
@@ -0,0 +1,276 @@
+use ExtUtils::MakeMaker;
+use Config;
+use strict;
+
+use vars qw($VERSION);
+
+$VERSION = "1.09";
+
+my %err = ();
+
+unlink "Errno.pm" if -f "Errno.pm";
+open OUT, ">Errno.pm" or die "Cannot open Errno.pm: $!";
+select OUT;
+my $file;
+foreach $file (get_files()) {
+    process_file($file);
+}
+write_errno_pm();
+unlink "errno.c" if -f "errno.c";
+
+sub process_file {
+    my($file) = @_;
+
+    return unless defined $file;
+
+    local *FH;
+    if (($^O eq 'VMS') && ($Config{vms_cc_type} ne 'gnuc')) {
+	unless(open(FH," LIBRARY/EXTRACT=ERRNO/OUTPUT=SYS\$OUTPUT $file |")) {
+            warn "Cannot open '$file'";
+            return;
+	}     
+    } else {
+	unless(open(FH,"< $file")) {
+            warn "Cannot open '$file'";
+            return;
+	}
+    }
+    while(<FH>) {
+	$err{$1} = 1
+	    if /^\s*#\s*define\s+(E\w+)\s+/;
+   }
+   close(FH);
+}
+
+sub get_files {
+    my %file = ();
+    # VMS keeps its include files in system libraries (well, except for Gcc)
+    if ($^O eq 'VMS') {
+	if ($Config{vms_cc_type} eq 'decc') {
+	    $file{'Sys$Library:DECC$RTLDEF.TLB'} = 1;
+	} elsif ($Config{vms_cc_type} eq 'vaxc') {
+	    $file{'Sys$Library:vaxcdef.tlb'} = 1;
+	} elsif ($Config{vms_cc_type} eq 'gcc') {
+	    $file{'gnu_cc_include:[000000]errno.h'} = 1;
+	}
+    } elsif ($^O eq 'os390') {
+	# OS/390 C compiler doesn't generate #file or #line directives
+	$file{'/usr/include/errno.h'} = 1;
+    } else {
+	open(CPPI,"> errno.c") or
+	    die "Cannot open errno.c";
+
+	print CPPI "#include <errno.h>\n";
+
+	close(CPPI);
+
+	# invoke CPP and read the output
+
+	open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or
+	    die "Cannot exec $Config{cpprun}";
+
+	my $pat;
+	if ($^O eq 'MSWin32' and $Config{cc} =~ /^bcc/i) {
+	    $pat = '^/\*\s+(.+)\s+\d+\s*:\s+\*/';
+	}
+	else {
+	    $pat = '^#(?:line)?\s*\d+\s+"([^"]+)"';
+	}
+	while(<CPPO>) {
+	    $file{$1} = 1 if /$pat/o;
+	}
+	close(CPPO);
+    }
+    return keys %file;
+}
+
+sub write_errno_pm {
+    my $err;
+
+    # create the CPP input
+
+    open(CPPI,"> errno.c") or
+	die "Cannot open errno.c";
+
+    print CPPI "#include <errno.h>\n";
+
+    foreach $err (keys %err) {
+	print CPPI '"',$err,'" [[',$err,']]',"\n";
+    }
+
+    close(CPPI);
+
+    # 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(!$Config{'cpprun'} or $^O eq 'next') {
+	# NeXT will do syntax checking unless it is reading from stdin
+	my $cpp = "$Config{cppstdin} $Config{cppflags} $Config{cppminus}";
+	open(CPPO,"$cpp < errno.c |")
+	    or die "Cannot exec $cpp";
+    } else {
+	open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or
+	    die "Cannot exec $Config{cpprun}";
+    }
+
+    %err = ();
+
+    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);
+
+    # Write Errno.pm
+
+    print <<"EDQ";
+#
+# This file is auto-generated. ***ANY*** changes here will be lost
+#
+
+package Errno;
+use vars qw(\@EXPORT_OK \%EXPORT_TAGS \@ISA \$VERSION \%errno \$AUTOLOAD);
+use Exporter ();
+use Config;
+use strict;
+
+\$Config{'myarchname'} eq "$Config{'myarchname'}" or
+	die "Errno architecture ($Config{'myarchname'}) does not match executable architecture (\$Config{'myarchname'})";
+
+\$VERSION = "$VERSION";
+\@ISA = qw(Exporter);
+
+EDQ
+   
+    my $len = 0;
+    my @err = sort { $err{$a} <=> $err{$b} } keys %err;
+    map { $len = length if length > $len } @err;
+
+    my $j = "\@EXPORT_OK = qw(" . join(" ",keys %err) . ");\n";
+    $j =~ s/(.{50,70})\s/$1\n\t/g;
+    print $j,"\n";
+
+print <<'ESQ';
+%EXPORT_TAGS = (
+    POSIX => [qw(
+ESQ
+
+    my $k = join(" ", grep { exists $err{$_} } 
+	qw(E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EAFNOSUPPORT
+	EAGAIN EALREADY EBADF EBUSY ECHILD ECONNABORTED
+	ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ EDOM EDQUOT
+	EEXIST EFAULT EFBIG EHOSTDOWN EHOSTUNREACH EINPROGRESS
+	EINTR EINVAL EIO EISCONN EISDIR ELOOP EMFILE EMLINK
+	EMSGSIZE ENAMETOOLONG ENETDOWN ENETRESET ENETUNREACH
+	ENFILE ENOBUFS ENODEV ENOENT ENOEXEC ENOLCK ENOMEM
+	ENOPROTOOPT ENOSPC ENOSYS ENOTBLK ENOTCONN ENOTDIR
+	ENOTEMPTY ENOTSOCK ENOTTY ENXIO EOPNOTSUPP EPERM
+	EPFNOSUPPORT EPIPE EPROCLIM EPROTONOSUPPORT EPROTOTYPE
+	ERANGE EREMOTE ERESTART EROFS ESHUTDOWN ESOCKTNOSUPPORT
+	ESPIPE ESRCH ESTALE ETIMEDOUT ETOOMANYREFS ETXTBSY
+	EUSERS EWOULDBLOCK EXDEV));
+
+    $k =~ s/(.{50,70})\s/$1\n\t/g;
+    print "\t",$k,"\n    )]\n);\n\n";
+
+    foreach $err (@err) {
+	printf "sub %s () { %d }\n",,$err,$err{$err};
+    }
+
+    print <<'ESQ';
+
+sub TIEHASH { bless [] }
+
+sub FETCH {
+    my ($self, $errname) = @_;
+    my $proto = prototype("Errno::$errname");
+    if (defined($proto) && $proto eq "") {
+	no strict 'refs';
+        return $! == &$errname;
+    }
+    require Carp;
+    Carp::confess("No errno $errname");
+} 
+
+sub STORE {
+    require Carp;
+    Carp::confess("ERRNO hash is read only!");
+}
+
+*CLEAR = \&STORE;
+*DELETE = \&STORE;
+
+sub NEXTKEY {
+    my($k,$v);
+    while(($k,$v) = each %Errno::) {
+	my $proto = prototype("Errno::$k");
+	last if (defined($proto) && $proto eq "");
+	
+    }
+    $k
+}
+
+sub FIRSTKEY {
+    my $s = scalar keys %Errno::;
+    goto &NEXTKEY;
+}
+
+sub EXISTS {
+    my ($self, $errname) = @_;
+    my $proto = prototype($errname);
+    defined($proto) && $proto eq "";
+}
+
+tie %!, __PACKAGE__;
+
+1;
+__END__
+
+=head1 NAME
+
+Errno - System errno constants
+
+=head1 SYNOPSIS
+
+    use Errno qw(EINTR EIO :POSIX);
+
+=head1 DESCRIPTION
+
+C<Errno> defines and conditionally exports all the error constants
+defined in your system C<errno.h> include file. It has a single export
+tag, C<:POSIX>, which will export all POSIX defined error numbers.
+
+C<Errno> also makes C<%!> magic such that each element of C<%!> has a non-zero
+value only if C<$!> is set to that value, eg
+
+    use Errno;
+    
+    unless (open(FH, "/fangorn/spouse")) {
+        if ($!{ENOENT}) {
+            warn "Get a wife!\n";
+        } else {
+            warn "This path is barred: $!";
+        } 
+    } 
+
+=head1 AUTHOR
+
+Graham Barr <gbarr@pobox.com>
+
+=head1 COPYRIGHT
+
+Copyright (c) 1997-8 Graham Barr. All rights reserved.
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
+ESQ
+
+}
diff --git a/contrib/perl5/ext/Errno/Makefile.PL b/contrib/perl5/ext/Errno/Makefile.PL
new file mode 100644
index 0000000..ffc8c4b
--- /dev/null
+++ b/contrib/perl5/ext/Errno/Makefile.PL
@@ -0,0 +1,29 @@
+use ExtUtils::MakeMaker;
+
+@VMS = ($^O eq 'VMS') ? (MAN3PODS => ' ') : ();
+
+WriteMakefile(
+    NAME	 => 'Errno',
+    VERSION_FROM => 'Errno_pm.PL',
+    PL_FILES	 => {'Errno_pm.PL'=>'Errno.pm'},
+    PM		 => {'Errno.pm' => '$(INST_LIBDIR)/Errno.pm'},
+    'clean'	 => {FILES => 'Errno.pm'},
+    'dist'	 => {
+	COMPRESS => 'gzip -9f',
+	SUFFIX   => '.gz', 
+	DIST_DEFAULT => 'd/Errno.pm tardist',
+    },
+    @VMS,
+);
+
+sub MY::postamble {
+    my $TARG = MM->catfile('d','Errno.pm');
+qq!$TARG : Makefile
+	echo '#This is a dummy file so CPAN will find a VERSION' > $TARG
+	echo 'package Errno;' >> $TARG
+	echo '\$\$VERSION = "\$(VERSION)";' >>$TARG
+	echo '#This is to make sure require will return an error' >>$TARG
+	echo '0;' >>$TARG
+
+!
+}
diff --git a/contrib/perl5/ext/Fcntl/Fcntl.pm b/contrib/perl5/ext/Fcntl/Fcntl.pm
new file mode 100644
index 0000000..f1edb8e
--- /dev/null
+++ b/contrib/perl5/ext/Fcntl/Fcntl.pm
@@ -0,0 +1,137 @@
+package Fcntl;
+
+=head1 NAME
+
+Fcntl - load the C Fcntl.h defines
+
+=head1 SYNOPSIS
+
+    use Fcntl;
+    use Fcntl qw(:DEFAULT :flock);
+
+=head1 DESCRIPTION
+
+This module is just a translation of the C F<fnctl.h> file.
+Unlike the old mechanism of requiring a translated F<fnctl.ph>
+file, this uses the B<h2xs> program (see the Perl source distribution)
+and your native C compiler.  This means that it has a 
+far more likely chance of getting the numbers right.
+
+=head1 NOTE
+
+Only C<#define> symbols get translated; you must still correctly
+pack up your own arguments to pass as args for locking functions, etc.
+
+=head1 EXPORTED SYMBOLS
+
+By default your system's F_* and O_* constants (eg, F_DUPFD and
+O_CREAT) and the FD_CLOEXEC constant are exported into your namespace.
+
+You can request that the flock() constants (LOCK_SH, LOCK_EX, LOCK_NB
+and LOCK_UN) be provided by using the tag C<:flock>.  See L<Exporter>.
+
+You can request that the old constants (FAPPEND, FASYNC, FCREAT,
+FDEFER, FEXCL, FNDELAY, FNONBLOCK, FSYNC, FTRUNC) be provided for
+compatibility reasons by using the tag C<:Fcompat>.  For new
+applications the newer versions of these constants are suggested
+(O_APPEND, O_ASYNC, O_CREAT, O_DEFER, O_EXCL, O_NDELAY, O_NONBLOCK,
+O_SYNC, O_TRUNC).
+
+Please refer to your native fcntl() and open() documentation to see
+what constants are implemented in your system.
+
+=cut
+
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $AUTOLOAD);
+
+require Exporter;
+require DynaLoader;
+@ISA = qw(Exporter DynaLoader);
+$VERSION = "1.03";
+# Items to export into callers namespace by default
+# (move infrequently used names to @EXPORT_OK below)
+@EXPORT =
+  qw(
+	FD_CLOEXEC
+	F_DUPFD
+	F_EXLCK
+	F_GETFD
+	F_GETFL
+	F_GETLK
+	F_GETOWN
+	F_POSIX
+	F_RDLCK
+	F_SETFD
+	F_SETFL
+	F_SETLK
+	F_SETLKW
+	F_SETOWN
+	F_SHLCK
+	F_UNLCK
+	F_WRLCK
+	O_ACCMODE
+	O_APPEND
+	O_ASYNC
+	O_BINARY
+	O_CREAT
+	O_DEFER
+	O_DSYNC
+	O_EXCL
+	O_EXLOCK
+	O_NDELAY
+	O_NOCTTY
+	O_NONBLOCK
+	O_RDONLY
+	O_RDWR
+	O_RSYNC
+	O_SHLOCK
+	O_SYNC
+	O_TEXT
+	O_TRUNC
+	O_WRONLY
+     );
+
+# Other items we are prepared to export if requested
+@EXPORT_OK = qw(
+	FAPPEND
+	FASYNC
+	FCREAT
+	FDEFER
+	FEXCL
+	FNDELAY
+	FNONBLOCK
+	FSYNC
+	FTRUNC
+	LOCK_EX
+	LOCK_NB
+	LOCK_SH
+	LOCK_UN
+);
+# Named groups of exports
+%EXPORT_TAGS = (
+    'flock'   => [qw(LOCK_SH LOCK_EX LOCK_NB LOCK_UN)],
+    'Fcompat' => [qw(FAPPEND FASYNC FCREAT FDEFER FEXCL
+	             FNDELAY FNONBLOCK FSYNC FTRUNC)],
+);
+
+sub AUTOLOAD {
+    (my $constname = $AUTOLOAD) =~ s/.*:://;
+    my $val = constant($constname, 0);
+    if ($! != 0) {
+	if ($! =~ /Invalid/) {
+	    $AutoLoader::AUTOLOAD = $AUTOLOAD;
+	    goto &AutoLoader::AUTOLOAD;
+	}
+	else {
+	    my ($pack,$file,$line) = caller;
+	    die "Your vendor has not defined Fcntl macro $constname, used at $file line $line.
+";
+	}
+    }
+    *$AUTOLOAD = sub { $val };
+    goto &$AUTOLOAD;
+}
+
+bootstrap Fcntl $VERSION;
+
+1;
diff --git a/contrib/perl5/ext/Fcntl/Fcntl.xs b/contrib/perl5/ext/Fcntl/Fcntl.xs
new file mode 100644
index 0000000..5149444
--- /dev/null
+++ b/contrib/perl5/ext/Fcntl/Fcntl.xs
@@ -0,0 +1,377 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#ifdef VMS
+#  include <file.h>
+#else
+#if defined(__GNUC__) && defined(__cplusplus) && defined(WIN32)
+#define _NO_OLDNAMES
+#endif 
+#  include <fcntl.h>
+#if defined(__GNUC__) && defined(__cplusplus) && defined(WIN32)
+#undef _NO_OLDNAMES
+#endif 
+#endif
+
+/* This comment is a kludge to get metaconfig to see the symbols
+    VAL_O_NONBLOCK
+    VAL_EAGAIN
+    RD_NODATA
+    EOF_NONBLOCK
+   and include the appropriate metaconfig unit
+   so that Configure will test how to turn on non-blocking I/O
+   for a file descriptor.  See config.h for how to use these
+   in your extension. 
+   
+   While I'm at it, I'll have metaconfig look for HAS_POLL too.
+   --AD  October 16, 1995
+*/
+
+static int
+not_here(char *s)
+{
+    croak("%s not implemented on this architecture", s);
+    return -1;
+}
+
+static double
+constant(char *name, int arg)
+{
+    errno = 0;
+    switch (*name) {
+    case 'F':
+	if (strnEQ(name, "F_", 2)) {
+	    if (strEQ(name, "F_DUPFD"))
+#ifdef F_DUPFD
+	        return F_DUPFD;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "F_EXLCK"))
+#ifdef F_EXLCK
+	        return F_EXLCK;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "F_GETFD"))
+#ifdef F_GETFD
+	        return F_GETFD;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "F_GETFL"))
+#ifdef F_GETFL
+	        return F_GETFL;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "F_GETLK"))
+#ifdef F_GETLK
+	        return F_GETLK;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "F_GETOWN"))
+#ifdef F_GETOWN
+	        return F_GETOWN;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "F_POSIX"))
+#ifdef F_POSIX
+	        return F_POSIX;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "F_RDLCK"))
+#ifdef F_RDLCK
+	        return F_RDLCK;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "F_SETFD"))
+#ifdef F_SETFD
+	        return F_SETFD;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "F_SETFL"))
+#ifdef F_SETFL
+	        return F_SETFL;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "F_SETLK"))
+#ifdef F_SETLK
+	        return F_SETLK;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "F_SETLKW"))
+#ifdef F_SETLKW
+	        return F_SETLKW;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "F_SETOWN"))
+#ifdef F_SETOWN
+	        return F_SETOWN;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "F_SHLCK"))
+#ifdef F_SHLCK
+	        return F_SHLCK;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "F_UNLCK"))
+#ifdef F_UNLCK
+	        return F_UNLCK;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "F_WRLCK"))
+#ifdef F_WRLCK
+	        return F_WRLCK;
+#else
+	        goto not_there;
+#endif
+	    errno = EINVAL;
+	    return 0;
+	}
+        if (strEQ(name, "FAPPEND"))
+#ifdef FAPPEND
+            return FAPPEND;
+#else
+            goto not_there;
+#endif
+        if (strEQ(name, "FASYNC"))
+#ifdef FASYNC
+            return FASYNC;
+#else
+            goto not_there;
+#endif
+        if (strEQ(name, "FCREAT"))
+#ifdef FCREAT
+            return FCREAT;
+#else
+            goto not_there;
+#endif
+	if (strEQ(name, "FD_CLOEXEC"))
+#ifdef FD_CLOEXEC
+	    return FD_CLOEXEC;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "FDEFER"))
+#ifdef FDEFER
+	    return FDEFER;
+#else
+	    goto not_there;
+#endif
+        if (strEQ(name, "FEXCL"))
+#ifdef FEXCL
+            return FEXCL;
+#else
+            goto not_there;
+#endif
+        if (strEQ(name, "FNDELAY"))
+#ifdef FNDELAY
+            return FNDELAY;
+#else
+            goto not_there;
+#endif
+        if (strEQ(name, "FNONBLOCK"))
+#ifdef FNONBLOCK
+            return FNONBLOCK;
+#else
+            goto not_there;
+#endif
+        if (strEQ(name, "FSYNC"))
+#ifdef FSYNC
+            return FSYNC;
+#else
+            goto not_there;
+#endif
+        if (strEQ(name, "FTRUNC"))
+#ifdef FTRUNC
+            return FTRUNC;
+#else
+            goto not_there;
+#endif
+	break;
+    case 'L':
+    	if (strnEQ(name, "LOCK_", 5)) {
+	    /* We support flock() on systems which don't have it, so
+	       always supply the constants. */
+	    if (strEQ(name, "LOCK_SH"))
+#ifdef LOCK_SH
+		return LOCK_SH;
+#else
+		return 1;
+#endif
+	    if (strEQ(name, "LOCK_EX"))
+#ifdef LOCK_EX
+		return LOCK_EX;
+#else
+		return 2;
+#endif
+    	    if (strEQ(name, "LOCK_NB"))
+#ifdef LOCK_NB
+		return LOCK_NB;
+#else
+		return 4;
+#endif
+    	    if (strEQ(name, "LOCK_UN"))
+#ifdef LOCK_UN
+    	    	return LOCK_UN;
+#else
+    	    	return 8;
+#endif
+	} else
+	  goto not_there;
+    	break;
+    case 'O':
+	if (strnEQ(name, "O_", 2)) {
+	    if (strEQ(name, "O_ACCMODE"))
+#ifdef O_ACCMODE
+	        return O_ACCMODE;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "O_APPEND"))
+#ifdef O_APPEND
+	        return O_APPEND;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "O_ASYNC"))
+#ifdef O_ASYNC
+	        return O_ASYNC;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "O_BINARY"))
+#ifdef O_BINARY
+	        return O_BINARY;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "O_CREAT"))
+#ifdef O_CREAT
+	        return O_CREAT;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "O_DEFER"))
+#ifdef O_DEFER
+	        return O_DEFER;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "O_DSYNC"))
+#ifdef O_DSYNC
+	        return O_DSYNC;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "O_EXCL"))
+#ifdef O_EXCL
+	        return O_EXCL;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "O_EXLOCK"))
+#ifdef O_EXLOCK
+	        return O_EXLOCK;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "O_NDELAY"))
+#ifdef O_NDELAY
+	        return O_NDELAY;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "O_NOCTTY"))
+#ifdef O_NOCTTY
+	        return O_NOCTTY;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "O_NONBLOCK"))
+#ifdef O_NONBLOCK
+	        return O_NONBLOCK;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "O_RDONLY"))
+#ifdef O_RDONLY
+	        return O_RDONLY;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "O_RDWR"))
+#ifdef O_RDWR
+	        return O_RDWR;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "O_RSYNC"))
+#ifdef O_RSYNC
+	        return O_RSYNC;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "O_SHLOCK"))
+#ifdef O_SHLOCK
+	        return O_SHLOCK;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "O_SYNC"))
+#ifdef O_SYNC
+	        return O_SYNC;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "O_TEXT"))
+#ifdef O_TEXT
+	        return O_TEXT;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "O_TRUNC"))
+#ifdef O_TRUNC
+	        return O_TRUNC;
+#else
+	        goto not_there;
+#endif
+	    if (strEQ(name, "O_WRONLY"))
+#ifdef O_WRONLY
+	        return O_WRONLY;
+#else
+	        goto not_there;
+#endif
+	} else
+	  goto not_there;
+	break;
+    }
+    errno = EINVAL;
+    return 0;
+
+not_there:
+    errno = ENOENT;
+    return 0;
+}
+
+
+MODULE = Fcntl		PACKAGE = Fcntl
+
+double
+constant(name,arg)
+	char *		name
+	int		arg
+
diff --git a/contrib/perl5/ext/Fcntl/Makefile.PL b/contrib/perl5/ext/Fcntl/Makefile.PL
new file mode 100644
index 0000000..66a6df6
--- /dev/null
+++ b/contrib/perl5/ext/Fcntl/Makefile.PL
@@ -0,0 +1,8 @@
+use ExtUtils::MakeMaker;
+WriteMakefile(
+    NAME 	=> 'Fcntl',
+    MAN3PODS 	=> ' ', 	# Pods will be built by installman.
+    XSPROTOARG => '-noprototypes', 		# XXX remove later?
+    VERSION_FROM => 'Fcntl.pm',
+);
+
diff --git a/contrib/perl5/ext/GDBM_File/GDBM_File.pm b/contrib/perl5/ext/GDBM_File/GDBM_File.pm
new file mode 100644
index 0000000..09df437
--- /dev/null
+++ b/contrib/perl5/ext/GDBM_File/GDBM_File.pm
@@ -0,0 +1,87 @@
+# GDBM_File.pm -- Perl 5 interface to GNU gdbm library.
+
+=head1 NAME
+
+GDBM_File - Perl5 access to the gdbm library.
+
+=head1 SYNOPSIS
+
+    use GDBM_File ;
+    tie %hash, 'GDBM_File', $filename, &GDBM_WRCREAT, 0640;
+    # Use the %hash array.
+    untie %hash ;
+
+=head1 DESCRIPTION
+
+B<GDBM_File> is a module which allows Perl programs to make use of the
+facilities provided by the GNU gdbm library.  If you intend to use this
+module you should really have a copy of the gdbm manualpage at hand.
+
+Most of the libgdbm.a functions are available through the GDBM_File
+interface.
+
+=head1 AVAILABILITY
+
+Gdbm is available from any GNU archive.  The master site is
+C<prep.ai.mit.edu>, but your are strongly urged to use one of the many
+mirrors.   You can obtain a list of mirror sites by issuing the
+command	C<finger fsf@prep.ai.mit.edu>.
+
+=head1 BUGS
+
+The available functions and the gdbm/perl interface need to be documented.
+
+=head1 SEE ALSO
+
+L<perl(1)>, L<DB_File(3)>. 
+
+=cut
+
+package GDBM_File;
+
+use strict;
+use vars qw($VERSION @ISA @EXPORT $AUTOLOAD);
+
+require Carp;
+require Tie::Hash;
+require Exporter;
+use AutoLoader;
+require DynaLoader;
+@ISA = qw(Tie::Hash Exporter DynaLoader);
+@EXPORT = qw(
+	GDBM_CACHESIZE
+	GDBM_FAST
+	GDBM_INSERT
+	GDBM_NEWDB
+	GDBM_READER
+	GDBM_REPLACE
+	GDBM_WRCREAT
+	GDBM_WRITER
+);
+
+$VERSION = "1.00";
+
+sub AUTOLOAD {
+    my($constname);
+    ($constname = $AUTOLOAD) =~ s/.*:://;
+    my $val = constant($constname, @_ ? $_[0] : 0);
+    if ($! != 0) {
+	if ($! =~ /Invalid/) {
+	    $AutoLoader::AUTOLOAD = $AUTOLOAD;
+	    goto &AutoLoader::AUTOLOAD;
+	}
+	else {
+	    Carp::croak("Your vendor has not defined GDBM_File macro $constname, used");
+	}
+    }
+    eval "sub $AUTOLOAD { $val }";
+    goto &$AUTOLOAD;
+}
+
+bootstrap GDBM_File $VERSION;
+
+# Preloaded methods go here.  Autoload methods go after __END__, and are
+# processed by the autosplit program.
+
+1;
+__END__
diff --git a/contrib/perl5/ext/GDBM_File/GDBM_File.xs b/contrib/perl5/ext/GDBM_File/GDBM_File.xs
new file mode 100644
index 0000000..ac1ca8c
--- /dev/null
+++ b/contrib/perl5/ext/GDBM_File/GDBM_File.xs
@@ -0,0 +1,243 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#include <gdbm.h>
+#include <fcntl.h>
+
+typedef GDBM_FILE GDBM_File;
+
+#define GDBM_BLOCKSIZE 0 /* gdbm defaults to stat blocksize */
+#define gdbm_TIEHASH(dbtype, name, read_write, mode, fatal_func) \
+	gdbm_open(name, GDBM_BLOCKSIZE, read_write, mode, fatal_func)
+
+#define gdbm_FETCH(db,key)			gdbm_fetch(db,key)
+#define gdbm_STORE(db,key,value,flags)		gdbm_store(db,key,value,flags)
+#define gdbm_DELETE(db,key)			gdbm_delete(db,key)
+#define gdbm_FIRSTKEY(db)			gdbm_firstkey(db)
+#define gdbm_NEXTKEY(db,key)			gdbm_nextkey(db,key)
+#define gdbm_EXISTS(db,key)			gdbm_exists(db,key)
+
+typedef datum gdatum;
+
+typedef void (*FATALFUNC)();
+
+static int
+not_here(char *s)
+{
+    croak("GDBM_File::%s not implemented on this architecture", s);
+    return -1;
+}
+
+/* Versions of gdbm prior to 1.7x might not have the gdbm_sync,
+   gdbm_exists, and gdbm_setopt functions.  Apparently Slackware
+   (Linux) 2.1 contains gdbm-1.5 (which dates back to 1991).
+*/
+#ifndef GDBM_FAST
+#define gdbm_exists(db,key) not_here("gdbm_exists")
+#define gdbm_sync(db) (void) not_here("gdbm_sync")
+#define gdbm_setopt(db,optflag,optval,optlen) not_here("gdbm_setopt")
+#endif
+
+static double
+constant(char *name, int arg)
+{
+    errno = 0;
+    switch (*name) {
+    case 'A':
+	break;
+    case 'B':
+	break;
+    case 'C':
+	break;
+    case 'D':
+	break;
+    case 'E':
+	break;
+    case 'F':
+	break;
+    case 'G':
+	if (strEQ(name, "GDBM_CACHESIZE"))
+#ifdef GDBM_CACHESIZE
+	    return GDBM_CACHESIZE;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "GDBM_FAST"))
+#ifdef GDBM_FAST
+	    return GDBM_FAST;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "GDBM_FASTMODE"))
+#ifdef GDBM_FASTMODE
+	    return GDBM_FASTMODE;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "GDBM_INSERT"))
+#ifdef GDBM_INSERT
+	    return GDBM_INSERT;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "GDBM_NEWDB"))
+#ifdef GDBM_NEWDB
+	    return GDBM_NEWDB;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "GDBM_READER"))
+#ifdef GDBM_READER
+	    return GDBM_READER;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "GDBM_REPLACE"))
+#ifdef GDBM_REPLACE
+	    return GDBM_REPLACE;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "GDBM_WRCREAT"))
+#ifdef GDBM_WRCREAT
+	    return GDBM_WRCREAT;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "GDBM_WRITER"))
+#ifdef GDBM_WRITER
+	    return GDBM_WRITER;
+#else
+	    goto not_there;
+#endif
+	break;
+    case 'H':
+	break;
+    case 'I':
+	break;
+    case 'J':
+	break;
+    case 'K':
+	break;
+    case 'L':
+	break;
+    case 'M':
+	break;
+    case 'N':
+	break;
+    case 'O':
+	break;
+    case 'P':
+	break;
+    case 'Q':
+	break;
+    case 'R':
+	break;
+    case 'S':
+	break;
+    case 'T':
+	break;
+    case 'U':
+	break;
+    case 'V':
+	break;
+    case 'W':
+	break;
+    case 'X':
+	break;
+    case 'Y':
+	break;
+    case 'Z':
+	break;
+    }
+    errno = EINVAL;
+    return 0;
+
+not_there:
+    errno = ENOENT;
+    return 0;
+}
+
+MODULE = GDBM_File	PACKAGE = GDBM_File	PREFIX = gdbm_
+
+double
+constant(name,arg)
+	char *		name
+	int		arg
+
+
+GDBM_File
+gdbm_TIEHASH(dbtype, name, read_write, mode, fatal_func = (FATALFUNC)croak)
+	char *		dbtype
+	char *		name
+	int		read_write
+	int		mode
+	FATALFUNC	fatal_func
+
+void
+gdbm_close(db)
+	GDBM_File	db
+	CLEANUP:
+
+void
+gdbm_DESTROY(db)
+	GDBM_File	db
+	CODE:
+	gdbm_close(db);
+
+gdatum
+gdbm_FETCH(db, key)
+	GDBM_File	db
+	datum		key
+
+int
+gdbm_STORE(db, key, value, flags = GDBM_REPLACE)
+	GDBM_File	db
+	datum		key
+	datum		value
+	int		flags
+    CLEANUP:
+	if (RETVAL) {
+	    if (RETVAL < 0 && errno == EPERM)
+		croak("No write permission to gdbm file");
+	    croak("gdbm store returned %d, errno %d, key \"%.*s\"",
+			RETVAL,errno,key.dsize,key.dptr);
+	    /* gdbm_clearerr(db); */
+	}
+
+int
+gdbm_DELETE(db, key)
+	GDBM_File	db
+	datum		key
+
+gdatum
+gdbm_FIRSTKEY(db)
+	GDBM_File	db
+
+gdatum
+gdbm_NEXTKEY(db, key)
+	GDBM_File	db
+	datum		key
+
+int
+gdbm_reorganize(db)
+	GDBM_File	db
+
+
+void
+gdbm_sync(db)
+	GDBM_File	db
+
+int
+gdbm_EXISTS(db, key)
+	GDBM_File	db
+	datum		key
+
+int
+gdbm_setopt (db, optflag, optval, optlen)
+	GDBM_File	db
+	int		optflag
+	int		&optval
+	int		optlen
+
diff --git a/contrib/perl5/ext/GDBM_File/Makefile.PL b/contrib/perl5/ext/GDBM_File/Makefile.PL
new file mode 100644
index 0000000..d244613
--- /dev/null
+++ b/contrib/perl5/ext/GDBM_File/Makefile.PL
@@ -0,0 +1,8 @@
+use ExtUtils::MakeMaker;
+WriteMakefile(
+    NAME => 'GDBM_File',
+    LIBS => ["-L/usr/local/lib -lgdbm", "-ldbm"],
+    MAN3PODS 	=> ' ', 	# Pods will be built by installman.
+    XSPROTOARG => '-noprototypes', 		# XXX remove later?
+    VERSION_FROM => 'GDBM_File.pm',
+);
diff --git a/contrib/perl5/ext/GDBM_File/typemap b/contrib/perl5/ext/GDBM_File/typemap
new file mode 100644
index 0000000..317a8f3
--- /dev/null
+++ b/contrib/perl5/ext/GDBM_File/typemap
@@ -0,0 +1,27 @@
+#
+#################################### DBM SECTION
+#
+
+datum			T_DATUM
+gdatum			T_GDATUM
+NDBM_File		T_PTROBJ
+GDBM_File		T_PTROBJ
+SDBM_File		T_PTROBJ
+ODBM_File		T_PTROBJ
+DB_File			T_PTROBJ
+DBZ_File		T_PTROBJ
+FATALFUNC		T_OPAQUEPTR
+
+INPUT
+T_DATUM
+	$var.dptr = SvPV($arg, PL_na);
+	$var.dsize = (int)PL_na;
+T_GDATUM
+	UNIMPLEMENTED
+OUTPUT
+T_DATUM
+	sv_setpvn($arg, $var.dptr, $var.dsize);
+T_GDATUM
+	sv_usepvn($arg, $var.dptr, $var.dsize);
+T_PTROBJ
+        sv_setref_pv($arg, dbtype, (void*)$var);
diff --git a/contrib/perl5/ext/IO/IO.pm b/contrib/perl5/ext/IO/IO.pm
new file mode 100644
index 0000000..4d4c81c
--- /dev/null
+++ b/contrib/perl5/ext/IO/IO.pm
@@ -0,0 +1,36 @@
+#
+
+package IO;
+
+=head1 NAME
+
+IO - load various IO modules
+
+=head1 SYNOPSIS
+
+    use IO;
+
+=head1 DESCRIPTION
+
+C<IO> provides a simple mechanism to load some of the IO modules at one go.
+Currently this includes:
+
+      IO::Handle
+      IO::Seekable
+      IO::File
+      IO::Pipe
+      IO::Socket
+
+For more information on any of these modules, please see its respective
+documentation.
+
+=cut
+
+use IO::Handle;
+use IO::Seekable;
+use IO::File;
+use IO::Pipe;
+use IO::Socket;
+
+1;
+
diff --git a/contrib/perl5/ext/IO/IO.xs b/contrib/perl5/ext/IO/IO.xs
new file mode 100644
index 0000000..a434cca
--- /dev/null
+++ b/contrib/perl5/ext/IO/IO.xs
@@ -0,0 +1,292 @@
+#include "EXTERN.h"
+#define PERLIO_NOT_STDIO 1
+#include "perl.h"
+#include "XSUB.h"
+
+#ifdef I_UNISTD
+#  include <unistd.h>
+#endif
+#ifdef I_FCNTL
+#if defined(__GNUC__) && defined(__cplusplus) && defined(WIN32)
+#define _NO_OLDNAMES
+#endif 
+#  include <fcntl.h>
+#if defined(__GNUC__) && defined(__cplusplus) && defined(WIN32)
+#undef _NO_OLDNAMES
+#endif 
+
+#endif
+
+#ifdef PerlIO
+typedef int SysRet;
+typedef PerlIO * InputStream;
+typedef PerlIO * OutputStream;
+#else
+#define PERLIO_IS_STDIO 1
+typedef int SysRet;
+typedef FILE * InputStream;
+typedef FILE * OutputStream;
+#endif
+
+static int
+not_here(char *s)
+{
+    croak("%s not implemented on this architecture", s);
+    return -1;
+}
+
+static bool
+constant(char *name, IV *pval)
+{
+    switch (*name) {
+    case '_':
+	if (strEQ(name, "_IOFBF"))
+#ifdef _IOFBF
+	    { *pval = _IOFBF; return TRUE; }
+#else
+	    return FALSE;
+#endif
+	if (strEQ(name, "_IOLBF"))
+#ifdef _IOLBF
+	    { *pval = _IOLBF; return TRUE; }
+#else
+	    return FALSE;
+#endif
+	if (strEQ(name, "_IONBF"))
+#ifdef _IONBF
+	    { *pval = _IONBF; return TRUE; }
+#else
+	    return FALSE;
+#endif
+	break;
+    case 'S':
+	if (strEQ(name, "SEEK_SET"))
+#ifdef SEEK_SET
+	    { *pval = SEEK_SET; return TRUE; }
+#else
+	    return FALSE;
+#endif
+	if (strEQ(name, "SEEK_CUR"))
+#ifdef SEEK_CUR
+	    { *pval = SEEK_CUR; return TRUE; }
+#else
+	    return FALSE;
+#endif
+	if (strEQ(name, "SEEK_END"))
+#ifdef SEEK_END
+	    { *pval = SEEK_END; return TRUE; }
+#else
+	    return FALSE;
+#endif
+	break;
+    }
+
+    return FALSE;
+}
+
+
+MODULE = IO	PACKAGE = IO::Seekable	PREFIX = f
+
+SV *
+fgetpos(handle)
+	InputStream	handle
+    CODE:
+	if (handle) {
+	    Fpos_t pos;
+#ifdef PerlIO
+	    PerlIO_getpos(handle, &pos);
+#else
+	    fgetpos(handle, &pos);
+#endif
+	    ST(0) = sv_2mortal(newSVpv((char*)&pos, sizeof(Fpos_t)));
+	}
+	else {
+	    ST(0) = &PL_sv_undef;
+	    errno = EINVAL;
+	}
+
+SysRet
+fsetpos(handle, pos)
+	InputStream	handle
+	SV *		pos
+    CODE:
+	char *p;
+	if (handle && (p = SvPVx(pos, PL_na)) && PL_na == sizeof(Fpos_t))
+#ifdef PerlIO
+	    RETVAL = PerlIO_setpos(handle, (Fpos_t*)p);
+#else
+	    RETVAL = fsetpos(handle, (Fpos_t*)p);
+#endif
+	else {
+	    RETVAL = -1;
+	    errno = EINVAL;
+	}
+    OUTPUT:
+	RETVAL
+
+MODULE = IO	PACKAGE = IO::File	PREFIX = f
+
+SV *
+new_tmpfile(packname = "IO::File")
+    char *		packname
+    PREINIT:
+	OutputStream fp;
+	GV *gv;
+    CODE:
+#ifdef PerlIO
+	fp = PerlIO_tmpfile();
+#else
+	fp = tmpfile();
+#endif
+	gv = (GV*)SvREFCNT_inc(newGVgen(packname));
+	hv_delete(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv), G_DISCARD);
+	if (do_open(gv, "+>&", 3, FALSE, 0, 0, fp)) {
+	    ST(0) = sv_2mortal(newRV((SV*)gv));
+	    sv_bless(ST(0), gv_stashpv(packname, TRUE));
+	    SvREFCNT_dec(gv);	/* undo increment in newRV() */
+	}
+	else {
+	    ST(0) = &PL_sv_undef;
+	    SvREFCNT_dec(gv);
+	}
+
+MODULE = IO	PACKAGE = IO::Handle	PREFIX = f
+
+SV *
+constant(name)
+	char *		name
+    CODE:
+	IV i;
+	if (constant(name, &i))
+	    ST(0) = sv_2mortal(newSViv(i));
+	else
+	    ST(0) = &PL_sv_undef;
+
+int
+ungetc(handle, c)
+	InputStream	handle
+	int		c
+    CODE:
+	if (handle)
+#ifdef PerlIO
+	    RETVAL = PerlIO_ungetc(handle, c);
+#else
+	    RETVAL = ungetc(c, handle);
+#endif
+	else {
+	    RETVAL = -1;
+	    errno = EINVAL;
+	}
+    OUTPUT:
+	RETVAL
+
+int
+ferror(handle)
+	InputStream	handle
+    CODE:
+	if (handle)
+#ifdef PerlIO
+	    RETVAL = PerlIO_error(handle);
+#else
+	    RETVAL = ferror(handle);
+#endif
+	else {
+	    RETVAL = -1;
+	    errno = EINVAL;
+	}
+    OUTPUT:
+	RETVAL
+
+int
+clearerr(handle)
+	InputStream	handle
+    CODE:
+	if (handle) {
+#ifdef PerlIO
+	    PerlIO_clearerr(handle);
+#else
+	    clearerr(handle);
+#endif
+	    RETVAL = 0;
+	}
+	else {
+	    RETVAL = -1;
+	    errno = EINVAL;
+	}
+    OUTPUT:
+	RETVAL
+
+int
+untaint(handle)
+       SV *	handle
+    CODE:
+#ifdef IOf_UNTAINT
+	IO * io;
+	io = sv_2io(handle);
+	if (io) {
+	    IoFLAGS(io) |= IOf_UNTAINT;
+	    RETVAL = 0;
+	}
+        else {
+#endif
+	    RETVAL = -1;
+	    errno = EINVAL;
+#ifdef IOf_UNTAINT
+	}
+#endif
+    OUTPUT:
+	RETVAL
+
+SysRet
+fflush(handle)
+	OutputStream	handle
+    CODE:
+	if (handle)
+#ifdef PerlIO
+	    RETVAL = PerlIO_flush(handle);
+#else
+	    RETVAL = Fflush(handle);
+#endif
+	else {
+	    RETVAL = -1;
+	    errno = EINVAL;
+	}
+    OUTPUT:
+	RETVAL
+
+void
+setbuf(handle, buf)
+	OutputStream	handle
+	char *		buf = SvPOK(ST(1)) ? sv_grow(ST(1), BUFSIZ) : 0;
+    CODE:
+	if (handle)
+#ifdef PERLIO_IS_STDIO
+	    setbuf(handle, buf);
+#else
+	    not_here("IO::Handle::setbuf");
+#endif
+
+SysRet
+setvbuf(handle, buf, type, size)
+	OutputStream	handle
+	char *		buf = SvPOK(ST(1)) ? sv_grow(ST(1), SvIV(ST(3))) : 0;
+	int		type
+	int		size
+    CODE:
+/* Should check HAS_SETVBUF once Configure tests for that */
+#if defined(PERLIO_IS_STDIO) && defined(_IOFBF)
+	if (!handle)			/* Try input stream. */
+	    handle = IoIFP(sv_2io(ST(0)));
+	if (handle)
+	    RETVAL = setvbuf(handle, buf, type, size);
+	else {
+	    RETVAL = -1;
+	    errno = EINVAL;
+	}
+#else
+	RETVAL = (SysRet) not_here("IO::Handle::setvbuf");
+#endif
+    OUTPUT:
+	RETVAL
+
+
diff --git a/contrib/perl5/ext/IO/Makefile.PL b/contrib/perl5/ext/IO/Makefile.PL
new file mode 100644
index 0000000..4a34be6
--- /dev/null
+++ b/contrib/perl5/ext/IO/Makefile.PL
@@ -0,0 +1,8 @@
+use ExtUtils::MakeMaker;
+WriteMakefile(
+    NAME => 'IO',
+    MAN3PODS   => ' ',			# Pods will be built by installman.
+    XSPROTOARG => '-noprototypes', 	# XXX remove later?
+    VERSION_FROM => 'lib/IO/Handle.pm',
+    XS_VERSION => 1.15
+);
diff --git a/contrib/perl5/ext/IO/README b/contrib/perl5/ext/IO/README
new file mode 100644
index 0000000..e855afa
--- /dev/null
+++ b/contrib/perl5/ext/IO/README
@@ -0,0 +1,4 @@
+This directory contains files from the IO distribution maintained by
+Graham Barr <bodg@tiuk.ti.com>. If you find that you have to modify
+any files in this directory then please forward him a patch for only
+the files in this directory.
diff --git a/contrib/perl5/ext/IO/lib/IO/File.pm b/contrib/perl5/ext/IO/lib/IO/File.pm
new file mode 100644
index 0000000..de7fabc
--- /dev/null
+++ b/contrib/perl5/ext/IO/lib/IO/File.pm
@@ -0,0 +1,167 @@
+#
+
+package IO::File;
+
+=head1 NAME
+
+IO::File - supply object methods for filehandles
+
+=head1 SYNOPSIS
+
+    use IO::File;
+
+    $fh = new IO::File;
+    if ($fh->open("< file")) {
+        print <$fh>;
+        $fh->close;
+    }
+
+    $fh = new IO::File "> file";
+    if (defined $fh) {
+        print $fh "bar\n";
+        $fh->close;
+    }
+
+    $fh = new IO::File "file", "r";
+    if (defined $fh) {
+        print <$fh>;
+        undef $fh;       # automatically closes the file
+    }
+
+    $fh = new IO::File "file", O_WRONLY|O_APPEND;
+    if (defined $fh) {
+        print $fh "corge\n";
+
+        $pos = $fh->getpos;
+        $fh->setpos($pos);
+
+        undef $fh;       # automatically closes the file
+    }
+
+    autoflush STDOUT 1;
+
+=head1 DESCRIPTION
+
+C<IO::File> inherits from C<IO::Handle> and C<IO::Seekable>. It extends
+these classes with methods that are specific to file handles.
+
+=head1 CONSTRUCTOR
+
+=over 4
+
+=item new ([ ARGS ] )
+
+Creates a C<IO::File>.  If it receives any parameters, they are passed to
+the method C<open>; if the open fails, the object is destroyed.  Otherwise,
+it is returned to the caller.
+
+=item new_tmpfile
+
+Creates an C<IO::File> opened for read/write on a newly created temporary
+file.  On systems where this is possible, the temporary file is anonymous
+(i.e. it is unlinked after creation, but held open).  If the temporary
+file cannot be created or opened, the C<IO::File> object is destroyed.
+Otherwise, it is returned to the caller.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item open( FILENAME [,MODE [,PERMS]] )
+
+C<open> accepts one, two or three parameters.  With one parameter,
+it is just a front end for the built-in C<open> function.  With two
+parameters, the first parameter is a filename that may include
+whitespace or other special characters, and the second parameter is
+the open mode, optionally followed by a file permission value.
+
+If C<IO::File::open> receives a Perl mode string ("E<gt>", "+E<lt>", etc.)
+or a POSIX fopen() mode string ("w", "r+", etc.), it uses the basic
+Perl C<open> operator.
+
+If C<IO::File::open> is given a numeric mode, it passes that mode
+and the optional permissions value to the Perl C<sysopen> operator.
+For convenience, C<IO::File::import> tries to import the O_XXX
+constants from the Fcntl module.  If dynamic loading is not available,
+this may fail, but the rest of IO::File will still work.
+
+=back
+
+=head1 SEE ALSO
+
+L<perlfunc>, 
+L<perlop/"I/O Operators">,
+L<IO::Handle>
+L<IO::Seekable>
+
+=head1 HISTORY
+
+Derived from FileHandle.pm by Graham Barr E<lt>F<bodg@tiuk.ti.com>E<gt>.
+
+=cut
+
+require 5.000;
+use strict;
+use vars qw($VERSION @EXPORT @EXPORT_OK $AUTOLOAD @ISA);
+use Carp;
+use Symbol;
+use SelectSaver;
+use IO::Seekable;
+
+require Exporter;
+require DynaLoader;
+
+@ISA = qw(IO::Handle IO::Seekable Exporter DynaLoader);
+
+$VERSION = "1.06021";
+
+@EXPORT = @IO::Seekable::EXPORT;
+
+eval {
+    # Make all Fcntl O_XXX constants available for importing
+    require Fcntl;
+    my @O = grep /^O_/, @Fcntl::EXPORT;
+    Fcntl->import(@O);  # first we import what we want to export
+    push(@EXPORT, @O);
+};
+
+
+################################################
+## Constructor
+##
+
+sub new {
+    my $type = shift;
+    my $class = ref($type) || $type || "IO::File";
+    @_ >= 0 && @_ <= 3
+	or croak "usage: new $class [FILENAME [,MODE [,PERMS]]]";
+    my $fh = $class->SUPER::new();
+    if (@_) {
+	$fh->open(@_)
+	    or return undef;
+    }
+    $fh;
+}
+
+################################################
+## Open
+##
+
+sub open {
+    @_ >= 2 && @_ <= 4 or croak 'usage: $fh->open(FILENAME [,MODE [,PERMS]])';
+    my ($fh, $file) = @_;
+    if (@_ > 2) {
+	my ($mode, $perms) = @_[2, 3];
+	if ($mode =~ /^\d+$/) {
+	    defined $perms or $perms = 0666;
+	    return sysopen($fh, $file, $mode, $perms);
+	}
+	$file = './' . $file if $file =~ m{\A[^\\/\w]};
+	$file = IO::Handle::_open_mode_string($mode) . " $file\0";
+    }
+    open($fh, $file);
+}
+
+1;
diff --git a/contrib/perl5/ext/IO/lib/IO/Handle.pm b/contrib/perl5/ext/IO/lib/IO/Handle.pm
new file mode 100644
index 0000000..7927641
--- /dev/null
+++ b/contrib/perl5/ext/IO/lib/IO/Handle.pm
@@ -0,0 +1,539 @@
+
+package IO::Handle;
+
+=head1 NAME
+
+IO::Handle - supply object methods for I/O handles
+
+=head1 SYNOPSIS
+
+    use IO::Handle;
+
+    $fh = new IO::Handle;
+    if ($fh->fdopen(fileno(STDIN),"r")) {
+        print $fh->getline;
+        $fh->close;
+    }
+
+    $fh = new IO::Handle;
+    if ($fh->fdopen(fileno(STDOUT),"w")) {
+        $fh->print("Some text\n");
+    }
+
+    use IO::Handle '_IOLBF';
+    $fh->setvbuf($buffer_var, _IOLBF, 1024);
+
+    undef $fh;       # automatically closes the file if it's open
+
+    autoflush STDOUT 1;
+
+=head1 DESCRIPTION
+
+C<IO::Handle> is the base class for all other IO handle classes. It is
+not intended that objects of C<IO::Handle> would be created directly,
+but instead C<IO::Handle> is inherited from by several other classes
+in the IO hierarchy.
+
+If you are reading this documentation, looking for a replacement for
+the C<FileHandle> package, then I suggest you read the documentation
+for C<IO::File>
+
+A C<IO::Handle> object is a reference to a symbol (see the C<Symbol> package)
+
+=head1 CONSTRUCTOR
+
+=over 4
+
+=item new ()
+
+Creates a new C<IO::Handle> object.
+
+=item new_from_fd ( FD, MODE )
+
+Creates a C<IO::Handle> like C<new> does.
+It requires two parameters, which are passed to the method C<fdopen>;
+if the fdopen fails, the object is destroyed. Otherwise, it is returned
+to the caller.
+
+=back
+
+=head1 METHODS
+
+See L<perlfunc> for complete descriptions of each of the following
+supported C<IO::Handle> methods, which are just front ends for the
+corresponding built-in functions:
+
+    close
+    fileno
+    getc
+    eof
+    read
+    truncate
+    stat
+    print
+    printf
+    sysread
+    syswrite
+
+See L<perlvar> for complete descriptions of each of the following
+supported C<IO::Handle> methods:
+
+    autoflush
+    output_field_separator
+    output_record_separator
+    input_record_separator
+    input_line_number
+    format_page_number
+    format_lines_per_page
+    format_lines_left
+    format_name
+    format_top_name
+    format_line_break_characters
+    format_formfeed
+    format_write
+
+Furthermore, for doing normal I/O you might need these:
+
+=over 
+
+=item $fh->fdopen ( FD, MODE )
+
+C<fdopen> is like an ordinary C<open> except that its first parameter
+is not a filename but rather a file handle name, a IO::Handle object,
+or a file descriptor number.
+
+=item $fh->opened
+
+Returns true if the object is currently a valid file descriptor.
+
+=item $fh->getline
+
+This works like <$fh> described in L<perlop/"I/O Operators">
+except that it's more readable and can be safely called in an
+array context but still returns just one line.
+
+=item $fh->getlines
+
+This works like <$fh> when called in an array context to
+read all the remaining lines in a file, except that it's more readable.
+It will also croak() if accidentally called in a scalar context.
+
+=item $fh->ungetc ( ORD )
+
+Pushes a character with the given ordinal value back onto the given
+handle's input stream.
+
+=item $fh->write ( BUF, LEN [, OFFSET }\] )
+
+This C<write> is like C<write> found in C, that is it is the
+opposite of read. The wrapper for the perl C<write> function is
+called C<format_write>.
+
+=item $fh->flush
+
+Flush the given handle's buffer.
+
+=item $fh->error
+
+Returns a true value if the given handle has experienced any errors
+since it was opened or since the last call to C<clearerr>.
+
+=item $fh->clearerr
+
+Clear the given handle's error indicator.
+
+=back
+
+If the C functions setbuf() and/or setvbuf() are available, then
+C<IO::Handle::setbuf> and C<IO::Handle::setvbuf> set the buffering
+policy for an IO::Handle.  The calling sequences for the Perl functions
+are the same as their C counterparts--including the constants C<_IOFBF>,
+C<_IOLBF>, and C<_IONBF> for setvbuf()--except that the buffer parameter
+specifies a scalar variable to use as a buffer.  WARNING: A variable
+used as a buffer by C<setbuf> or C<setvbuf> must not be modified in any
+way until the IO::Handle is closed or C<setbuf> or C<setvbuf> is called
+again, or memory corruption may result!  Note that you need to import
+the constants C<_IOFBF>, C<_IOLBF>, and C<_IONBF> explicitly.
+
+Lastly, there is a special method for working under B<-T> and setuid/gid
+scripts:
+
+=over
+
+=item $fh->untaint
+
+Marks the object as taint-clean, and as such data read from it will also
+be considered taint-clean. Note that this is a very trusting action to
+take, and appropriate consideration for the data source and potential
+vulnerability should be kept in mind.
+
+=back
+
+=head1 NOTE
+
+A C<IO::Handle> object is a GLOB reference. Some modules that
+inherit from C<IO::Handle> may want to keep object related variables
+in the hash table part of the GLOB. In an attempt to prevent modules
+trampling on each other I propose the that any such module should prefix
+its variables with its own name separated by _'s. For example the IO::Socket
+module keeps a C<timeout> variable in 'io_socket_timeout'.
+
+=head1 SEE ALSO
+
+L<perlfunc>, 
+L<perlop/"I/O Operators">,
+L<IO::File>
+
+=head1 BUGS
+
+Due to backwards compatibility, all filehandles resemble objects
+of class C<IO::Handle>, or actually classes derived from that class.
+They actually aren't.  Which means you can't derive your own 
+class from C<IO::Handle> and inherit those methods.
+
+=head1 HISTORY
+
+Derived from FileHandle.pm by Graham Barr E<lt>F<bodg@tiuk.ti.com>E<gt>
+
+=cut
+
+require 5.000;
+use strict;
+use vars qw($VERSION $XS_VERSION @EXPORT_OK $AUTOLOAD @ISA);
+use Carp;
+use Symbol;
+use SelectSaver;
+
+require Exporter;
+@ISA = qw(Exporter);
+
+$VERSION = "1.1505";
+$XS_VERSION = "1.15";
+
+@EXPORT_OK = qw(
+    autoflush
+    output_field_separator
+    output_record_separator
+    input_record_separator
+    input_line_number
+    format_page_number
+    format_lines_per_page
+    format_lines_left
+    format_name
+    format_top_name
+    format_line_break_characters
+    format_formfeed
+    format_write
+
+    print
+    printf
+    getline
+    getlines
+
+    SEEK_SET
+    SEEK_CUR
+    SEEK_END
+    _IOFBF
+    _IOLBF
+    _IONBF
+);
+
+
+################################################
+## Interaction with the XS.
+##
+
+require DynaLoader;
+@IO::ISA = qw(DynaLoader);
+bootstrap IO $XS_VERSION;
+
+sub AUTOLOAD {
+    if ($AUTOLOAD =~ /::(_?[a-z])/) {
+	$AutoLoader::AUTOLOAD = $AUTOLOAD;
+	goto &AutoLoader::AUTOLOAD
+    }
+    my $constname = $AUTOLOAD;
+    $constname =~ s/.*:://;
+    my $val = constant($constname);
+    defined $val or croak "$constname is not a valid IO::Handle macro";
+    no strict 'refs';
+    *$AUTOLOAD = sub { $val };
+    goto &$AUTOLOAD;
+}
+
+
+################################################
+## Constructors, destructors.
+##
+
+sub new {
+    my $class = ref($_[0]) || $_[0] || "IO::Handle";
+    @_ == 1 or croak "usage: new $class";
+    my $fh = gensym;
+    bless $fh, $class;
+}
+
+sub new_from_fd {
+    my $class = ref($_[0]) || $_[0] || "IO::Handle";
+    @_ == 3 or croak "usage: new_from_fd $class FD, MODE";
+    my $fh = gensym;
+    shift;
+    IO::Handle::fdopen($fh, @_)
+	or return undef;
+    bless $fh, $class;
+}
+
+#
+# There is no need for DESTROY to do anything, because when the
+# last reference to an IO object is gone, Perl automatically
+# closes its associated files (if any).  However, to avoid any
+# attempts to autoload DESTROY, we here define it to do nothing.
+#
+sub DESTROY {}
+
+
+################################################
+## Open and close.
+##
+
+sub _open_mode_string {
+    my ($mode) = @_;
+    $mode =~ /^\+?(<|>>?)$/
+      or $mode =~ s/^r(\+?)$/$1</
+      or $mode =~ s/^w(\+?)$/$1>/
+      or $mode =~ s/^a(\+?)$/$1>>/
+      or croak "IO::Handle: bad open mode: $mode";
+    $mode;
+}
+
+sub fdopen {
+    @_ == 3 or croak 'usage: $fh->fdopen(FD, MODE)';
+    my ($fh, $fd, $mode) = @_;
+    local(*GLOB);
+
+    if (ref($fd) && "".$fd =~ /GLOB\(/o) {
+	# It's a glob reference; Alias it as we cannot get name of anon GLOBs
+	my $n = qualify(*GLOB);
+	*GLOB = *{*$fd};
+	$fd =  $n;
+    } elsif ($fd =~ m#^\d+$#) {
+	# It's an FD number; prefix with "=".
+	$fd = "=$fd";
+    }
+
+    open($fh, _open_mode_string($mode) . '&' . $fd)
+	? $fh : undef;
+}
+
+sub close {
+    @_ == 1 or croak 'usage: $fh->close()';
+    my($fh) = @_;
+
+    close($fh);
+}
+
+################################################
+## Normal I/O functions.
+##
+
+# flock
+# select
+
+sub opened {
+    @_ == 1 or croak 'usage: $fh->opened()';
+    defined fileno($_[0]);
+}
+
+sub fileno {
+    @_ == 1 or croak 'usage: $fh->fileno()';
+    fileno($_[0]);
+}
+
+sub getc {
+    @_ == 1 or croak 'usage: $fh->getc()';
+    getc($_[0]);
+}
+
+sub eof {
+    @_ == 1 or croak 'usage: $fh->eof()';
+    eof($_[0]);
+}
+
+sub print {
+    @_ or croak 'usage: $fh->print([ARGS])';
+    my $this = shift;
+    print $this @_;
+}
+
+sub printf {
+    @_ >= 2 or croak 'usage: $fh->printf(FMT,[ARGS])';
+    my $this = shift;
+    printf $this @_;
+}
+
+sub getline {
+    @_ == 1 or croak 'usage: $fh->getline';
+    my $this = shift;
+    return scalar <$this>;
+} 
+
+*gets = \&getline;  # deprecated
+
+sub getlines {
+    @_ == 1 or croak 'usage: $fh->getline()';
+    wantarray or
+	croak 'Can\'t call $fh->getlines in a scalar context, use $fh->getline';
+    my $this = shift;
+    return <$this>;
+}
+
+sub truncate {
+    @_ == 2 or croak 'usage: $fh->truncate(LEN)';
+    truncate($_[0], $_[1]);
+}
+
+sub read {
+    @_ == 3 || @_ == 4 or croak '$fh->read(BUF, LEN [, OFFSET])';
+    read($_[0], $_[1], $_[2], $_[3] || 0);
+}
+
+sub sysread {
+    @_ == 3 || @_ == 4 or croak '$fh->sysread(BUF, LEN [, OFFSET])';
+    sysread($_[0], $_[1], $_[2], $_[3] || 0);
+}
+
+sub write {
+    @_ == 3 || @_ == 4 or croak '$fh->write(BUF, LEN [, OFFSET])';
+    local($\) = "";
+    print { $_[0] } substr($_[1], $_[3] || 0, $_[2]);
+}
+
+sub syswrite {
+    @_ == 3 || @_ == 4 or croak '$fh->syswrite(BUF, LEN [, OFFSET])';
+    syswrite($_[0], $_[1], $_[2], $_[3] || 0);
+}
+
+sub stat {
+    @_ == 1 or croak 'usage: $fh->stat()';
+    stat($_[0]);
+}
+
+################################################
+## State modification functions.
+##
+
+sub autoflush {
+    my $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
+    my $prev = $|;
+    $| = @_ > 1 ? $_[1] : 1;
+    $prev;
+}
+
+sub output_field_separator {
+    my $prev = $,;
+    $, = $_[1] if @_ > 1;
+    $prev;
+}
+
+sub output_record_separator {
+    my $prev = $\;
+    $\ = $_[1] if @_ > 1;
+    $prev;
+}
+
+sub input_record_separator {
+    my $prev = $/;
+    $/ = $_[1] if @_ > 1;
+    $prev;
+}
+
+sub input_line_number {
+    # localizing $. doesn't work as advertised.  grrrrrr.
+    my $prev = $.;
+    $. = $_[1] if @_ > 1;
+    $prev;
+}
+
+sub format_page_number {
+    my $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
+    my $prev = $%;
+    $% = $_[1] if @_ > 1;
+    $prev;
+}
+
+sub format_lines_per_page {
+    my $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
+    my $prev = $=;
+    $= = $_[1] if @_ > 1;
+    $prev;
+}
+
+sub format_lines_left {
+    my $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
+    my $prev = $-;
+    $- = $_[1] if @_ > 1;
+    $prev;
+}
+
+sub format_name {
+    my $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
+    my $prev = $~;
+    $~ = qualify($_[1], caller) if @_ > 1;
+    $prev;
+}
+
+sub format_top_name {
+    my $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
+    my $prev = $^;
+    $^ = qualify($_[1], caller) if @_ > 1;
+    $prev;
+}
+
+sub format_line_break_characters {
+    my $prev = $:;
+    $: = $_[1] if @_ > 1;
+    $prev;
+}
+
+sub format_formfeed {
+    my $prev = $^L;
+    $^L = $_[1] if @_ > 1;
+    $prev;
+}
+
+sub formline {
+    my $fh = shift;
+    my $picture = shift;
+    local($^A) = $^A;
+    local($\) = "";
+    formline($picture, @_);
+    print $fh $^A;
+}
+
+sub format_write {
+    @_ < 3 || croak 'usage: $fh->write( [FORMAT_NAME] )';
+    if (@_ == 2) {
+	my ($fh, $fmt) = @_;
+	my $oldfmt = $fh->format_name($fmt);
+	CORE::write($fh);
+	$fh->format_name($oldfmt);
+    } else {
+	CORE::write($_[0]);
+    }
+}
+
+sub fcntl {
+    @_ == 3 || croak 'usage: $fh->fcntl( OP, VALUE );';
+    my ($fh, $op, $val) = @_;
+    my $r = fcntl($fh, $op, $val);
+    defined $r && $r eq "0 but true" ? 0 : $r;
+}
+
+sub ioctl {
+    @_ == 3 || croak 'usage: $fh->ioctl( OP, VALUE );';
+    my ($fh, $op, $val) = @_;
+    my $r = ioctl($fh, $op, $val);
+    defined $r && $r eq "0 but true" ? 0 : $r;
+}
+
+1;
diff --git a/contrib/perl5/ext/IO/lib/IO/Pipe.pm b/contrib/perl5/ext/IO/lib/IO/Pipe.pm
new file mode 100644
index 0000000..ae6d9a5
--- /dev/null
+++ b/contrib/perl5/ext/IO/lib/IO/Pipe.pm
@@ -0,0 +1,239 @@
+# IO::Pipe.pm
+#
+# Copyright (c) 1996 Graham Barr <Graham.Barr@tiuk.ti.com>. All rights
+# reserved. This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+package IO::Pipe;
+
+require 5.000;
+
+use IO::Handle;
+use strict;
+use vars qw($VERSION);
+use Carp;
+use Symbol;
+
+$VERSION = "1.0901";
+
+sub new {
+    my $type = shift;
+    my $class = ref($type) || $type || "IO::Pipe";
+    @_ == 0 || @_ == 2 or croak "usage: new $class [READFH, WRITEFH]";
+
+    my $me = bless gensym(), $class;
+
+    my($readfh,$writefh) = @_ ? @_ : $me->handles;
+
+    pipe($readfh, $writefh)
+	or return undef;
+
+    @{*$me} = ($readfh, $writefh);
+
+    $me;
+}
+
+sub handles {
+    @_ == 1 or croak 'usage: $pipe->handles()';
+    (IO::Pipe::End->new(), IO::Pipe::End->new());
+}
+
+my $do_spawn = $^O eq 'os2';
+
+sub _doit {
+    my $me = shift;
+    my $rw = shift;
+
+    my $pid = $do_spawn ? 0 : fork();
+
+    if($pid) { # Parent
+        return $pid;
+    }
+    elsif(defined $pid) { # Child or spawn
+        my $fh;
+        my $io = $rw ? \*STDIN : \*STDOUT;
+        my ($mode, $save) = $rw ? "r" : "w";
+        if ($do_spawn) {
+          require Fcntl;
+          $save = IO::Handle->new_from_fd($io, $mode);
+          # Close in child:
+          fcntl(shift, Fcntl::F_SETFD(), 1) or croak "fcntl: $!";
+          $fh = $rw ? ${*$me}[0] : ${*$me}[1];
+        } else {
+          shift;
+          $fh = $rw ? $me->reader() : $me->writer(); # close the other end
+        }
+        bless $io, "IO::Handle";
+        $io->fdopen($fh, $mode);
+        $fh->close;
+
+        if ($do_spawn) {
+          $pid = eval { system 1, @_ }; # 1 == P_NOWAIT
+          my $err = $!;
+    
+          $io->fdopen($save, $mode);
+          $save->close or croak "Cannot close $!";
+          croak "IO::Pipe: Cannot spawn-NOWAIT: $err" if not $pid or $pid < 0;
+          return $pid;
+        } else {
+          exec @_ or
+            croak "IO::Pipe: Cannot exec: $!";
+        }
+    }
+    else {
+        croak "IO::Pipe: Cannot fork: $!";
+    }
+
+    # NOT Reached
+}
+
+sub reader {
+    @_ >= 1 or croak 'usage: $pipe->reader()';
+    my $me = shift;
+    my $fh  = ${*$me}[0];
+    my $pid = $me->_doit(0, $fh, @_)
+        if(@_);
+
+    close ${*$me}[1];
+    bless $me, ref($fh);
+    *{*$me} = *{*$fh};          # Alias self to handle
+    bless $fh;                  # Really wan't un-bless here
+    ${*$me}{'io_pipe_pid'} = $pid
+        if defined $pid;
+
+    $me;
+}
+
+sub writer {
+    @_ >= 1 or croak 'usage: $pipe->writer()';
+    my $me = shift;
+    my $fh  = ${*$me}[1];
+    my $pid = $me->_doit(1, $fh, @_)
+        if(@_);
+
+    close ${*$me}[0];
+    bless $me, ref($fh);
+    *{*$me} = *{*$fh};          # Alias self to handle
+    bless $fh;                  # Really wan't un-bless here
+    ${*$me}{'io_pipe_pid'} = $pid
+        if defined $pid;
+
+    $me;
+}
+
+package IO::Pipe::End;
+
+use vars qw(@ISA);
+
+@ISA = qw(IO::Handle);
+
+sub close {
+    my $fh = shift;
+    my $r = $fh->SUPER::close(@_);
+
+    waitpid(${*$fh}{'io_pipe_pid'},0)
+	if(defined ${*$fh}{'io_pipe_pid'});
+
+    $r;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+IO::pipe - supply object methods for pipes
+
+=head1 SYNOPSIS
+
+	use IO::Pipe;
+
+	$pipe = new IO::Pipe;
+
+	if($pid = fork()) { # Parent
+	    $pipe->reader();
+
+	    while(<$pipe> {
+		....
+	    }
+
+	}
+	elsif(defined $pid) { # Child
+	    $pipe->writer();
+
+	    print $pipe ....
+	}
+
+	or
+
+	$pipe = new IO::Pipe;
+
+	$pipe->reader(qw(ls -l));
+
+	while(<$pipe>) {
+	    ....
+	}
+
+=head1 DESCRIPTION
+
+C<IO::Pipe> provides an interface to createing pipes between
+processes.
+
+=head1 CONSTRCUTOR
+
+=over 4
+
+=item new ( [READER, WRITER] )
+
+Creates a C<IO::Pipe>, which is a reference to a newly created symbol
+(see the C<Symbol> package). C<IO::Pipe::new> optionally takes two
+arguments, which should be objects blessed into C<IO::Handle>, or a
+subclass thereof. These two objects will be used for the system call
+to C<pipe>. If no arguments are given then method C<handles> is called
+on the new C<IO::Pipe> object.
+
+These two handles are held in the array part of the GLOB until either
+C<reader> or C<writer> is called.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item reader ([ARGS])
+
+The object is re-blessed into a sub-class of C<IO::Handle>, and becomes a
+handle at the reading end of the pipe. If C<ARGS> are given then C<fork>
+is called and C<ARGS> are passed to exec.
+
+=item writer ([ARGS])
+
+The object is re-blessed into a sub-class of C<IO::Handle>, and becomes a
+handle at the writing end of the pipe. If C<ARGS> are given then C<fork>
+is called and C<ARGS> are passed to exec.
+
+=item handles ()
+
+This method is called during construction by C<IO::Pipe::new>
+on the newly created C<IO::Pipe> object. It returns an array of two objects
+blessed into C<IO::Pipe::End>, or a subclass thereof.
+
+=back
+
+=head1 SEE ALSO
+
+L<IO::Handle>
+
+=head1 AUTHOR
+
+Graham Barr <bodg@tiuk.ti.com>
+
+=head1 COPYRIGHT
+
+Copyright (c) 1996 Graham Barr. All rights reserved. This program is free
+software; you can redistribute it and/or modify it under the same terms
+as Perl itself.
+
+=cut
diff --git a/contrib/perl5/ext/IO/lib/IO/Seekable.pm b/contrib/perl5/ext/IO/lib/IO/Seekable.pm
new file mode 100644
index 0000000..91c381a
--- /dev/null
+++ b/contrib/perl5/ext/IO/lib/IO/Seekable.pm
@@ -0,0 +1,68 @@
+#
+
+package IO::Seekable;
+
+=head1 NAME
+
+IO::Seekable - supply seek based methods for I/O objects
+
+=head1 SYNOPSIS
+
+    use IO::Seekable;
+    package IO::Something;
+    @ISA = qw(IO::Seekable);
+
+=head1 DESCRIPTION
+
+C<IO::Seekable> does not have a constuctor of its own as is intended to
+be inherited by other C<IO::Handle> based objects. It provides methods
+which allow seeking of the file descriptors.
+
+If the C functions fgetpos() and fsetpos() are available, then
+C<IO::File::getpos> returns an opaque value that represents the
+current position of the IO::File, and C<IO::File::setpos> uses
+that value to return to a previously visited position.
+
+See L<perlfunc> for complete descriptions of each of the following
+supported C<IO::Seekable> methods, which are just front ends for the
+corresponding built-in functions:
+
+    seek
+    tell
+
+=head1 SEE ALSO
+
+L<perlfunc>, 
+L<perlop/"I/O Operators">,
+L<IO::Handle>
+L<IO::File>
+
+=head1 HISTORY
+
+Derived from FileHandle.pm by Graham Barr E<lt>bodg@tiuk.ti.comE<gt>
+
+=cut
+
+require 5.000;
+use Carp;
+use strict;
+use vars qw($VERSION @EXPORT @ISA);
+use IO::Handle qw(SEEK_SET SEEK_CUR SEEK_END);
+require Exporter;
+
+@EXPORT = qw(SEEK_SET SEEK_CUR SEEK_END);
+@ISA = qw(Exporter);
+
+$VERSION = "1.06";
+
+sub seek {
+    @_ == 3 or croak 'usage: $fh->seek(POS, WHENCE)';
+    seek($_[0], $_[1], $_[2]);
+}
+
+sub tell {
+    @_ == 1 or croak 'usage: $fh->tell()';
+    tell($_[0]);
+}
+
+1;
diff --git a/contrib/perl5/ext/IO/lib/IO/Select.pm b/contrib/perl5/ext/IO/lib/IO/Select.pm
new file mode 100644
index 0000000..dea684a
--- /dev/null
+++ b/contrib/perl5/ext/IO/lib/IO/Select.pm
@@ -0,0 +1,371 @@
+# IO::Select.pm
+#
+# Copyright (c) 1995 Graham Barr. All rights reserved. This program is free
+# software; you can redistribute it and/or modify it under the same terms
+# as Perl itself.
+
+package IO::Select;
+
+=head1 NAME
+
+IO::Select - OO interface to the select system call
+
+=head1 SYNOPSIS
+
+    use IO::Select;
+
+    $s = IO::Select->new();
+
+    $s->add(\*STDIN);
+    $s->add($some_handle);
+
+    @ready = $s->can_read($timeout);
+
+    @ready = IO::Select->new(@handles)->read(0);
+
+=head1 DESCRIPTION
+
+The C<IO::Select> package implements an object approach to the system C<select>
+function call. It allows the user to see what IO handles, see L<IO::Handle>,
+are ready for reading, writing or have an error condition pending.
+
+=head1 CONSTRUCTOR
+
+=over 4
+
+=item new ( [ HANDLES ] )
+
+The constructor creates a new object and optionally initialises it with a set
+of handles.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item add ( HANDLES )
+
+Add the list of handles to the C<IO::Select> object. It is these values that
+will be returned when an event occurs. C<IO::Select> keeps these values in a
+cache which is indexed by the C<fileno> of the handle, so if more than one
+handle with the same C<fileno> is specified then only the last one is cached.
+
+Each handle can be an C<IO::Handle> object, an integer or an array
+reference where the first element is a C<IO::Handle> or an integer.
+
+=item remove ( HANDLES )
+
+Remove all the given handles from the object. This method also works
+by the C<fileno> of the handles. So the exact handles that were added
+need not be passed, just handles that have an equivalent C<fileno>
+
+=item exists ( HANDLE )
+
+Returns a true value (actually the handle itself) if it is present.
+Returns undef otherwise.
+
+=item handles
+
+Return an array of all registered handles.
+
+=item can_read ( [ TIMEOUT ] )
+
+Return an array of handles that are ready for reading. C<TIMEOUT> is
+the maximum amount of time to wait before returning an empty list. If
+C<TIMEOUT> is not given and any handles are registered then the call
+will block.
+
+=item can_write ( [ TIMEOUT ] )
+
+Same as C<can_read> except check for handles that can be written to.
+
+=item has_error ( [ TIMEOUT ] )
+
+Same as C<can_read> except check for handles that have an error
+condition, for example EOF.
+
+=item count ()
+
+Returns the number of handles that the object will check for when
+one of the C<can_> methods is called or the object is passed to
+the C<select> static method.
+
+=item bits()
+
+Return the bit string suitable as argument to the core select() call.
+
+=item bits()
+
+Return the bit string suitable as argument to the core select() call.
+
+=item select ( READ, WRITE, ERROR [, TIMEOUT ] )
+
+C<select> is a static method, that is you call it with the package
+name like C<new>. C<READ>, C<WRITE> and C<ERROR> are either C<undef>
+or C<IO::Select> objects. C<TIMEOUT> is optional and has the same
+effect as for the core select call.
+
+The result will be an array of 3 elements, each a reference to an array
+which will hold the handles that are ready for reading, writing and have
+error conditions respectively. Upon error an empty array is returned.
+
+=back
+
+=head1 EXAMPLE
+
+Here is a short example which shows how C<IO::Select> could be used
+to write a server which communicates with several sockets while also
+listening for more connections on a listen socket
+
+    use IO::Select;
+    use IO::Socket;
+
+    $lsn = new IO::Socket::INET(Listen => 1, LocalPort => 8080);
+    $sel = new IO::Select( $lsn );
+    
+    while(@ready = $sel->can_read) {
+        foreach $fh (@ready) {
+            if($fh == $lsn) {
+                # Create a new socket
+                $new = $lsn->accept;
+                $sel->add($new);
+            }
+            else {
+                # Process socket
+
+                # Maybe we have finished with the socket
+                $sel->remove($fh);
+                $fh->close;
+            }
+        }
+    }
+
+=head1 AUTHOR
+
+Graham Barr E<lt>F<Graham.Barr@tiuk.ti.com>E<gt>
+
+=head1 COPYRIGHT
+
+Copyright (c) 1995 Graham Barr. All rights reserved. This program is free
+software; you can redistribute it and/or modify it under the same terms
+as Perl itself.
+
+=cut
+
+use     strict;
+use     vars qw($VERSION @ISA);
+require Exporter;
+
+$VERSION = "1.10";
+
+@ISA = qw(Exporter); # This is only so we can do version checking
+
+sub VEC_BITS () {0}
+sub FD_COUNT () {1}
+sub FIRST_FD () {2}
+
+sub new
+{
+ my $self = shift;
+ my $type = ref($self) || $self;
+
+ my $vec = bless [undef,0], $type;
+
+ $vec->add(@_)
+    if @_;
+
+ $vec;
+}
+
+sub add
+{
+ shift->_update('add', @_);
+}
+
+
+sub remove
+{
+ shift->_update('remove', @_);
+}
+
+
+sub exists
+{
+ my $vec = shift;
+ $vec->[$vec->_fileno(shift) + FIRST_FD];
+}
+
+
+sub _fileno
+{
+ my($self, $f) = @_;
+ $f = $f->[0] if ref($f) eq 'ARRAY';
+ ($f =~ /^\d+$/) ? $f : fileno($f);
+}
+
+sub _update
+{
+ my $vec = shift;
+ my $add = shift eq 'add';
+
+ my $bits = $vec->[VEC_BITS];
+ $bits = '' unless defined $bits;
+
+ my $count = 0;
+ my $f;
+ foreach $f (@_)
+  {
+   my $fn = $vec->_fileno($f);
+   next unless defined $fn;
+   my $i = $fn + FIRST_FD;
+   if ($add) {
+     if (defined $vec->[$i]) {
+	 $vec->[$i] = $f;  # if array rest might be different, so we update
+	 next;
+     }
+     $vec->[FD_COUNT]++;
+     vec($bits, $fn, 1) = 1;
+     $vec->[$i] = $f;
+   } else {      # remove
+     next unless defined $vec->[$i];
+     $vec->[FD_COUNT]--;
+     vec($bits, $fn, 1) = 0;
+     $vec->[$i] = undef;
+   }
+   $count++;
+  }
+ $vec->[VEC_BITS] = $vec->[FD_COUNT] ? $bits : undef;
+ $count;
+}
+
+sub can_read
+{
+ my $vec = shift;
+ my $timeout = shift;
+ my $r = $vec->[VEC_BITS];
+
+ defined($r) && (select($r,undef,undef,$timeout) > 0)
+    ? handles($vec, $r)
+    : ();
+}
+
+sub can_write
+{
+ my $vec = shift;
+ my $timeout = shift;
+ my $w = $vec->[VEC_BITS];
+
+ defined($w) && (select(undef,$w,undef,$timeout) > 0)
+    ? handles($vec, $w)
+    : ();
+}
+
+sub has_error
+{
+ my $vec = shift;
+ my $timeout = shift;
+ my $e = $vec->[VEC_BITS];
+
+ defined($e) && (select(undef,undef,$e,$timeout) > 0)
+    ? handles($vec, $e)
+    : ();
+}
+
+sub count
+{
+ my $vec = shift;
+ $vec->[FD_COUNT];
+}
+
+sub bits
+{
+ my $vec = shift;
+ $vec->[VEC_BITS];
+}
+
+sub as_string  # for debugging
+{
+ my $vec = shift;
+ my $str = ref($vec) . ": ";
+ my $bits = $vec->bits;
+ my $count = $vec->count;
+ $str .= defined($bits) ? unpack("b*", $bits) : "undef";
+ $str .= " $count";
+ my @handles = @$vec;
+ splice(@handles, 0, FIRST_FD);
+ for (@handles) {
+     $str .= " " . (defined($_) ? "$_" : "-");
+ }
+ $str;
+}
+
+sub _max
+{
+ my($a,$b,$c) = @_;
+ $a > $b
+    ? $a > $c
+        ? $a
+        : $c
+    : $b > $c
+        ? $b
+        : $c;
+}
+
+sub select
+{
+ shift
+   if defined $_[0] && !ref($_[0]);
+
+ my($r,$w,$e,$t) = @_;
+ my @result = ();
+
+ my $rb = defined $r ? $r->[VEC_BITS] : undef;
+ my $wb = defined $w ? $w->[VEC_BITS] : undef;
+ my $eb = defined $e ? $e->[VEC_BITS] : undef;
+
+ if(select($rb,$wb,$eb,$t) > 0)
+  {
+   my @r = ();
+   my @w = ();
+   my @e = ();
+   my $i = _max(defined $r ? scalar(@$r)-1 : 0,
+                defined $w ? scalar(@$w)-1 : 0,
+                defined $e ? scalar(@$e)-1 : 0);
+
+   for( ; $i >= FIRST_FD ; $i--)
+    {
+     my $j = $i - FIRST_FD;
+     push(@r, $r->[$i])
+        if defined $rb && defined $r->[$i] && vec($rb, $j, 1);
+     push(@w, $w->[$i])
+        if defined $wb && defined $w->[$i] && vec($wb, $j, 1);
+     push(@e, $e->[$i])
+        if defined $eb && defined $e->[$i] && vec($eb, $j, 1);
+    }
+
+   @result = (\@r, \@w, \@e);
+  }
+ @result;
+}
+
+
+sub handles
+{
+ my $vec = shift;
+ my $bits = shift;
+ my @h = ();
+ my $i;
+ my $max = scalar(@$vec) - 1;
+
+ for ($i = FIRST_FD; $i <= $max; $i++)
+  {
+   next unless defined $vec->[$i];
+   push(@h, $vec->[$i])
+      if !defined($bits) || vec($bits, $i - FIRST_FD, 1);
+  }
+ 
+ @h;
+}
+
+1;
diff --git a/contrib/perl5/ext/IO/lib/IO/Socket.pm b/contrib/perl5/ext/IO/lib/IO/Socket.pm
new file mode 100644
index 0000000..406f74d
--- /dev/null
+++ b/contrib/perl5/ext/IO/lib/IO/Socket.pm
@@ -0,0 +1,728 @@
+# IO::Socket.pm
+#
+# Copyright (c) 1996 Graham Barr <Graham.Barr@tiuk.ti.com>. All rights
+# reserved. This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+package IO::Socket;
+
+=head1 NAME
+
+IO::Socket - Object interface to socket communications
+
+=head1 SYNOPSIS
+
+    use IO::Socket;
+
+=head1 DESCRIPTION
+
+C<IO::Socket> provides an object interface to creating and using sockets. It
+is built upon the L<IO::Handle> interface and inherits all the methods defined
+by L<IO::Handle>.
+
+C<IO::Socket> only defines methods for those operations which are common to all
+types of socket. Operations which are specified to a socket in a particular 
+domain have methods defined in sub classes of C<IO::Socket>
+
+C<IO::Socket> will export all functions (and constants) defined by L<Socket>.
+
+=head1 CONSTRUCTOR
+
+=over 4
+
+=item new ( [ARGS] )
+
+Creates an C<IO::Socket>, which is a reference to a
+newly created symbol (see the C<Symbol> package). C<new>
+optionally takes arguments, these arguments are in key-value pairs.
+C<new> only looks for one key C<Domain> which tells new which domain
+the socket will be in. All other arguments will be passed to the
+configuration method of the package for that domain, See below.
+
+C<IO::Socket>s will be in autoflush mode after creation.  Note that
+versions of IO::Socket prior to 1.1603 (as shipped with Perl 5.004_04)
+did not do this.   So if you need backward compatibility, you should
+set autoflush explicitly.
+
+=back
+
+=head1 METHODS
+
+See L<perlfunc> for complete descriptions of each of the following
+supported C<IO::Socket> methods, which are just front ends for the
+corresponding built-in functions:
+
+    socket
+    socketpair
+    bind
+    listen
+    accept
+    send
+    recv
+    peername (getpeername)
+    sockname (getsockname)
+
+Some methods take slightly different arguments to those defined in L<perlfunc>
+in attempt to make the interface more flexible. These are
+
+=over 4
+
+=item accept([PKG])
+
+perform the system call C<accept> on the socket and return a new object. The
+new object will be created in the same class as the listen socket, unless
+C<PKG> is specified. This object can be used to communicate with the client
+that was trying to connect. In a scalar context the new socket is returned,
+or undef upon failure. In an array context a two-element array is returned
+containing the new socket and the peer address, the list will
+be empty upon failure.
+
+Additional methods that are provided are
+
+=item timeout([VAL])
+
+Set or get the timeout value associated with this socket. If called without
+any arguments then the current setting is returned. If called with an argument
+the current setting is changed and the previous value returned.
+
+=item sockopt(OPT [, VAL])
+
+Unified method to both set and get options in the SOL_SOCKET level. If called
+with one argument then getsockopt is called, otherwise setsockopt is called.
+
+=item sockdomain
+
+Returns the numerical number for the socket domain type. For example, for
+a AF_INET socket the value of &AF_INET will be returned.
+
+=item socktype
+
+Returns the numerical number for the socket type. For example, for
+a SOCK_STREAM socket the value of &SOCK_STREAM will be returned.
+
+=item protocol
+
+Returns the numerical number for the protocol being used on the socket, if
+known. If the protocol is unknown, as with an AF_UNIX socket, zero
+is returned.
+
+=back
+
+=cut
+
+
+require 5.000;
+
+use Config;
+use IO::Handle;
+use Socket 1.3;
+use Carp;
+use strict;
+use vars qw(@ISA $VERSION);
+use Exporter;
+
+@ISA = qw(IO::Handle);
+
+$VERSION = "1.1603";
+
+sub import {
+    my $pkg = shift;
+    my $callpkg = caller;
+    Exporter::export 'Socket', $callpkg, @_;
+}
+
+sub new {
+    my($class,%arg) = @_;
+    my $fh = $class->SUPER::new();
+    $fh->autoflush;
+
+    ${*$fh}{'io_socket_timeout'} = delete $arg{Timeout};
+
+    return scalar(%arg) ? $fh->configure(\%arg)
+			: $fh;
+}
+
+my @domain2pkg = ();
+
+sub register_domain {
+    my($p,$d) = @_;
+    $domain2pkg[$d] = $p;
+}
+
+sub configure {
+    my($fh,$arg) = @_;
+    my $domain = delete $arg->{Domain};
+
+    croak 'IO::Socket: Cannot configure a generic socket'
+	unless defined $domain;
+
+    croak "IO::Socket: Unsupported socket domain"
+	unless defined $domain2pkg[$domain];
+
+    croak "IO::Socket: Cannot configure socket in domain '$domain'"
+	unless ref($fh) eq "IO::Socket";
+
+    bless($fh, $domain2pkg[$domain]);
+    $fh->configure($arg);
+}
+
+sub socket {
+    @_ == 4 or croak 'usage: $fh->socket(DOMAIN, TYPE, PROTOCOL)';
+    my($fh,$domain,$type,$protocol) = @_;
+
+    socket($fh,$domain,$type,$protocol) or
+    	return undef;
+
+    ${*$fh}{'io_socket_domain'} = $domain;
+    ${*$fh}{'io_socket_type'}   = $type;
+    ${*$fh}{'io_socket_proto'}  = $protocol;
+
+    $fh;
+}
+
+sub socketpair {
+    @_ == 4 || croak 'usage: IO::Socket->pair(DOMAIN, TYPE, PROTOCOL)';
+    my($class,$domain,$type,$protocol) = @_;
+    my $fh1 = $class->new();
+    my $fh2 = $class->new();
+
+    socketpair($fh1,$fh2,$domain,$type,$protocol) or
+    	return ();
+
+    ${*$fh1}{'io_socket_type'}  = ${*$fh2}{'io_socket_type'}  = $type;
+    ${*$fh1}{'io_socket_proto'} = ${*$fh2}{'io_socket_proto'} = $protocol;
+
+    ($fh1,$fh2);
+}
+
+sub connect {
+    @_ == 2 || @_ == 3 or croak 'usage: $fh->connect(NAME) or $fh->connect(PORT, ADDR)';
+    my $fh = shift;
+    my $addr = @_ == 1 ? shift : sockaddr_in(@_);
+    my $timeout = ${*$fh}{'io_socket_timeout'};
+    local($SIG{ALRM}) = $timeout ? sub { undef $fh; }
+				 : $SIG{ALRM} || 'DEFAULT';
+
+     eval {
+    	croak 'connect: Bad address'
+    	    if(@_ == 2 && !defined $_[1]);
+
+    	if($timeout) {
+    	    defined $Config{d_alarm} && defined alarm($timeout) or
+    	    	$timeout = 0;
+    	}
+
+	my $ok = connect($fh, $addr);
+
+    	alarm(0)
+    	    if($timeout);
+
+	croak "connect: timeout"
+	    unless defined $fh;
+
+	undef $fh unless $ok;
+    };
+
+    $fh;
+}
+
+sub bind {
+    @_ == 2 || @_ == 3 or croak 'usage: $fh->bind(NAME) or $fh->bind(PORT, ADDR)';
+    my $fh = shift;
+    my $addr = @_ == 1 ? shift : sockaddr_in(@_);
+
+    return bind($fh, $addr) ? $fh
+			    : undef;
+}
+
+sub listen {
+    @_ >= 1 && @_ <= 2 or croak 'usage: $fh->listen([QUEUE])';
+    my($fh,$queue) = @_;
+    $queue = 5
+	unless $queue && $queue > 0;
+
+    return listen($fh, $queue) ? $fh
+			       : undef;
+}
+
+sub accept {
+    @_ == 1 || @_ == 2 or croak 'usage $fh->accept([PKG])';
+    my $fh = shift;
+    my $pkg = shift || $fh;
+    my $timeout = ${*$fh}{'io_socket_timeout'};
+    my $new = $pkg->new(Timeout => $timeout);
+    my $peer = undef;
+
+    eval {
+    	if($timeout) {
+    	    my $fdset = "";
+    	    vec($fdset, $fh->fileno,1) = 1;
+    	    croak "accept: timeout"
+    	    	unless select($fdset,undef,undef,$timeout);
+    	}
+    	$peer = accept($new,$fh);
+    };
+
+    return wantarray ? defined $peer ? ($new, $peer)
+    	    	    	    	     : () 
+    	      	     : defined $peer ? $new
+    	    	    	    	     : undef;
+}
+
+sub sockname {
+    @_ == 1 or croak 'usage: $fh->sockname()';
+    getsockname($_[0]);
+}
+
+sub peername {
+    @_ == 1 or croak 'usage: $fh->peername()';
+    my($fh) = @_;
+    getpeername($fh)
+      || ${*$fh}{'io_socket_peername'}
+      || undef;
+}
+
+sub send {
+    @_ >= 2 && @_ <= 4 or croak 'usage: $fh->send(BUF, [FLAGS, [TO]])';
+    my $fh    = $_[0];
+    my $flags = $_[2] || 0;
+    my $peer  = $_[3] || $fh->peername;
+
+    croak 'send: Cannot determine peer address'
+	 unless($peer);
+
+    my $r = defined(getpeername($fh))
+	? send($fh, $_[1], $flags)
+	: send($fh, $_[1], $flags, $peer);
+
+    # remember who we send to, if it was sucessful
+    ${*$fh}{'io_socket_peername'} = $peer
+	if(@_ == 4 && defined $r);
+
+    $r;
+}
+
+sub recv {
+    @_ == 3 || @_ == 4 or croak 'usage: $fh->recv(BUF, LEN [, FLAGS])';
+    my $sock  = $_[0];
+    my $len   = $_[2];
+    my $flags = $_[3] || 0;
+
+    # remember who we recv'd from
+    ${*$sock}{'io_socket_peername'} = recv($sock, $_[1]='', $len, $flags);
+}
+
+
+sub setsockopt {
+    @_ == 4 or croak '$fh->setsockopt(LEVEL, OPTNAME)';
+    setsockopt($_[0],$_[1],$_[2],$_[3]);
+}
+
+my $intsize = length(pack("i",0));
+
+sub getsockopt {
+    @_ == 3 or croak '$fh->getsockopt(LEVEL, OPTNAME)';
+    my $r = getsockopt($_[0],$_[1],$_[2]);
+    # Just a guess
+    $r = unpack("i", $r)
+	if(defined $r && length($r) == $intsize);
+    $r;
+}
+
+sub sockopt {
+    my $fh = shift;
+    @_ == 1 ? $fh->getsockopt(SOL_SOCKET,@_)
+	    : $fh->setsockopt(SOL_SOCKET,@_);
+}
+
+sub timeout {
+    @_ == 1 || @_ == 2 or croak 'usage: $fh->timeout([VALUE])';
+    my($fh,$val) = @_;
+    my $r = ${*$fh}{'io_socket_timeout'} || undef;
+
+    ${*$fh}{'io_socket_timeout'} = 0 + $val
+	if(@_ == 2);
+
+    $r;
+}
+
+sub sockdomain {
+    @_ == 1 or croak 'usage: $fh->sockdomain()';
+    my $fh = shift;
+    ${*$fh}{'io_socket_domain'};
+}
+
+sub socktype {
+    @_ == 1 or croak 'usage: $fh->socktype()';
+    my $fh = shift;
+    ${*$fh}{'io_socket_type'}
+}
+
+sub protocol {
+    @_ == 1 or croak 'usage: $fh->protocol()';
+    my($fh) = @_;
+    ${*$fh}{'io_socket_protocol'};
+}
+
+=head1 SUB-CLASSES
+
+=cut
+
+##
+## AF_INET
+##
+
+package IO::Socket::INET;
+
+use strict;
+use vars qw(@ISA);
+use Socket;
+use Carp;
+use Exporter;
+
+@ISA = qw(IO::Socket);
+
+IO::Socket::INET->register_domain( AF_INET );
+
+my %socket_type = ( tcp => SOCK_STREAM,
+		    udp => SOCK_DGRAM,
+		    icmp => SOCK_RAW,
+		  );
+
+=head2 IO::Socket::INET
+
+C<IO::Socket::INET> provides a constructor to create an AF_INET domain socket
+and some related methods. The constructor can take the following options
+
+    PeerAddr	Remote host address          <hostname>[:<port>]
+    PeerPort	Remote port or service       <service>[(<no>)] | <no>
+    LocalAddr	Local host bind	address      hostname[:port]
+    LocalPort	Local host bind	port         <service>[(<no>)] | <no>
+    Proto	Protocol name (or number)    "tcp" | "udp" | ...
+    Type	Socket type                  SOCK_STREAM | SOCK_DGRAM | ...
+    Listen	Queue size for listen
+    Reuse	Set SO_REUSEADDR before binding
+    Timeout	Timeout	value for various operations
+
+
+If C<Listen> is defined then a listen socket is created, else if the
+socket type, which is derived from the protocol, is SOCK_STREAM then
+connect() is called.
+
+The C<PeerAddr> can be a hostname or the IP-address on the
+"xx.xx.xx.xx" form.  The C<PeerPort> can be a number or a symbolic
+service name.  The service name might be followed by a number in
+parenthesis which is used if the service is not known by the system.
+The C<PeerPort> specification can also be embedded in the C<PeerAddr>
+by preceding it with a ":".
+
+If C<Proto> is not given and you specify a symbolic C<PeerPort> port,
+then the constructor will try to derive C<Proto> from the service
+name.  As a last resort C<Proto> "tcp" is assumed.  The C<Type>
+parameter will be deduced from C<Proto> if not specified.
+
+If the constructor is only passed a single argument, it is assumed to
+be a C<PeerAddr> specification.
+
+Examples:
+
+   $sock = IO::Socket::INET->new(PeerAddr => 'www.perl.org',
+                                 PeerPort => 'http(80)',
+                                 Proto    => 'tcp');
+
+   $sock = IO::Socket::INET->new(PeerAddr => 'localhost:smtp(25)');
+
+   $sock = IO::Socket::INET->new(Listen    => 5,
+                                 LocalAddr => 'localhost',
+                                 LocalPort => 9000,
+                                 Proto     => 'tcp');
+
+   $sock = IO::Socket::INET->new('127.0.0.1:25');
+
+
+=head2 METHODS
+
+=over 4
+
+=item sockaddr ()
+
+Return the address part of the sockaddr structure for the socket
+
+=item sockport ()
+
+Return the port number that the socket is using on the local host
+
+=item sockhost ()
+
+Return the address part of the sockaddr structure for the socket in a
+text form xx.xx.xx.xx
+
+=item peeraddr ()
+
+Return the address part of the sockaddr structure for the socket on
+the peer host
+
+=item peerport ()
+
+Return the port number for the socket on the peer host.
+
+=item peerhost ()
+
+Return the address part of the sockaddr structure for the socket on the
+peer host in a text form xx.xx.xx.xx
+
+=back
+
+=cut
+
+sub new
+{
+  my $class = shift;
+  unshift(@_, "PeerAddr") if @_ == 1;
+  return $class->SUPER::new(@_);
+}
+
+sub _sock_info {
+  my($addr,$port,$proto) = @_;
+  my @proto = ();
+  my @serv = ();
+
+  $port = $1
+	if(defined $addr && $addr =~ s,:([\w\(\)/]+)$,,);
+
+  if(defined $proto) {
+    @proto = $proto =~ m,\D, ? getprotobyname($proto)
+			     : getprotobynumber($proto);
+
+    $proto = $proto[2] || undef;
+  }
+
+  if(defined $port) {
+    $port =~ s,\((\d+)\)$,,;
+
+    my $defport = $1 || undef;
+    my $pnum = ($port =~ m,^(\d+)$,)[0];
+
+    @serv= getservbyname($port, $proto[0] || "")
+	if($port =~ m,\D,);
+
+    $port = $pnum || $serv[2] || $defport || undef;
+
+    $proto = (getprotobyname($serv[3]))[2] || undef
+	if @serv && !$proto;
+  }
+
+ return ($addr || undef,
+	 $port || undef,
+	 $proto || undef
+	);
+}
+
+sub _error {
+    my $fh = shift;
+    $@ = join("",ref($fh),": ",@_);
+    carp $@ if $^W;
+    close($fh)
+	if(defined fileno($fh));
+    return undef;
+}
+
+sub configure {
+    my($fh,$arg) = @_;
+    my($lport,$rport,$laddr,$raddr,$proto,$type);
+
+
+    ($laddr,$lport,$proto) = _sock_info($arg->{LocalAddr},
+					$arg->{LocalPort},
+					$arg->{Proto});
+
+    $laddr = defined $laddr ? inet_aton($laddr)
+			    : INADDR_ANY;
+
+    return _error($fh,"Bad hostname '",$arg->{LocalAddr},"'")
+	unless(defined $laddr);
+
+    unless(exists $arg->{Listen}) {
+	($raddr,$rport,$proto) = _sock_info($arg->{PeerAddr},
+					    $arg->{PeerPort},
+					    $proto);
+    }
+
+    if(defined $raddr) {
+	$raddr = inet_aton($raddr);
+	return _error($fh,"Bad hostname '",$arg->{PeerAddr},"'")
+		unless(defined $raddr);
+    }
+
+    $proto ||= (getprotobyname "tcp")[2];
+    return _error($fh,'Cannot determine protocol')
+	unless($proto);
+
+    my $pname = (getprotobynumber($proto))[0];
+    $type = $arg->{Type} || $socket_type{$pname};
+
+    $fh->socket(AF_INET, $type, $proto) or
+	return _error($fh,"$!");
+
+    if ($arg->{Reuse}) {
+	$fh->sockopt(SO_REUSEADDR,1) or
+		return _error($fh);
+    }
+
+    $fh->bind($lport || 0, $laddr) or
+	return _error($fh,"$!");
+
+    if(exists $arg->{Listen}) {
+	$fh->listen($arg->{Listen} || 5) or
+	    return _error($fh,"$!");
+    }
+    else {
+	return _error($fh,'Cannot determine remote port')
+		unless($rport || $type == SOCK_DGRAM || $type == SOCK_RAW);
+
+	if($type == SOCK_STREAM || defined $raddr) {
+	    return _error($fh,'Bad peer address')
+	    	unless(defined $raddr);
+
+	    $fh->connect($rport,$raddr) or
+		return _error($fh,"$!");
+	}
+    }
+
+    $fh;
+}
+
+sub sockaddr {
+    @_ == 1 or croak 'usage: $fh->sockaddr()';
+    my($fh) = @_;
+    (sockaddr_in($fh->sockname))[1];
+}
+
+sub sockport {
+    @_ == 1 or croak 'usage: $fh->sockport()';
+    my($fh) = @_;
+    (sockaddr_in($fh->sockname))[0];
+}
+
+sub sockhost {
+    @_ == 1 or croak 'usage: $fh->sockhost()';
+    my($fh) = @_;
+    inet_ntoa($fh->sockaddr);
+}
+
+sub peeraddr {
+    @_ == 1 or croak 'usage: $fh->peeraddr()';
+    my($fh) = @_;
+    (sockaddr_in($fh->peername))[1];
+}
+
+sub peerport {
+    @_ == 1 or croak 'usage: $fh->peerport()';
+    my($fh) = @_;
+    (sockaddr_in($fh->peername))[0];
+}
+
+sub peerhost {
+    @_ == 1 or croak 'usage: $fh->peerhost()';
+    my($fh) = @_;
+    inet_ntoa($fh->peeraddr);
+}
+
+##
+## AF_UNIX
+##
+
+package IO::Socket::UNIX;
+
+use strict;
+use vars qw(@ISA $VERSION);
+use Socket;
+use Carp;
+use Exporter;
+
+@ISA = qw(IO::Socket);
+
+IO::Socket::UNIX->register_domain( AF_UNIX );
+
+=head2 IO::Socket::UNIX
+
+C<IO::Socket::UNIX> provides a constructor to create an AF_UNIX domain socket
+and some related methods. The constructor can take the following options
+
+    Type    	Type of socket (eg SOCK_STREAM or SOCK_DGRAM)
+    Local   	Path to local fifo
+    Peer    	Path to peer fifo
+    Listen  	Create a listen socket
+
+=head2 METHODS
+
+=over 4
+
+=item hostpath()
+
+Returns the pathname to the fifo at the local end
+
+=item peerpath()
+
+Returns the pathanme to the fifo at the peer end
+
+=back
+
+=cut
+
+sub configure {
+    my($fh,$arg) = @_;
+    my($bport,$cport);
+
+    my $type = $arg->{Type} || SOCK_STREAM;
+
+    $fh->socket(AF_UNIX, $type, 0) or
+	return undef;
+
+    if(exists $arg->{Local}) {
+	my $addr = sockaddr_un($arg->{Local});
+	$fh->bind($addr) or
+	    return undef;
+    }
+    if(exists $arg->{Listen}) {
+	$fh->listen($arg->{Listen} || 5) or
+	    return undef;
+    }
+    elsif(exists $arg->{Peer}) {
+	my $addr = sockaddr_un($arg->{Peer});
+	$fh->connect($addr) or
+	    return undef;
+    }
+
+    $fh;
+}
+
+sub hostpath {
+    @_ == 1 or croak 'usage: $fh->hostpath()';
+    my $n = $_[0]->sockname || return undef;
+    (sockaddr_un($n))[0];
+}
+
+sub peerpath {
+    @_ == 1 or croak 'usage: $fh->peerpath()';
+    my $n = $_[0]->peername || return undef;
+    (sockaddr_un($n))[0];
+}
+
+=head1 SEE ALSO
+
+L<Socket>, L<IO::Handle>
+
+=head1 AUTHOR
+
+Graham Barr E<lt>F<Graham.Barr@tiuk.ti.com>E<gt>
+
+=head1 COPYRIGHT
+
+Copyright (c) 1996 Graham Barr. All rights reserved. This program is free
+software; you can redistribute it and/or modify it under the same terms
+as Perl itself.
+
+=cut
+
+1; # Keep require happy
diff --git a/contrib/perl5/ext/IPC/SysV/ChangeLog b/contrib/perl5/ext/IPC/SysV/ChangeLog
new file mode 100644
index 0000000..fff95be
--- /dev/null
+++ b/contrib/perl5/ext/IPC/SysV/ChangeLog
@@ -0,0 +1,28 @@
+Fri Jul  3 15:06:40 1998  Jarkko Hietaniemi  <jhi@iki.fi>
+
+	- Integrated IPC::SysV 1.03 to Perl 5.004_69.
+
+Change 142 on 1998/05/31 by <gbarr@pobox.com> (Graham Barr)
+
+	- Changed SHMLBA from a constSUB to an XS sub as on some systems it is not
+	  a constant
+	- Added a missing MODULE line to SysV.xs so ftok is defined in IPC::SysV
+
+Change 138 on 1998/05/23 by <gbarr@pobox.com> (Graham Barr)
+
+	Applied patch from Jarkko Hietaniemi to add constats for UNICOS
+	
+	Reduced size of XS object by changing constant sub definition
+	into a loop
+	
+	Updated POD to include ftok()
+
+Change 135 on 1998/05/18 by <gbarr@pobox.com> (Graham Barr)
+
+	applied changes from Jarkko Hietaniemi <jhi@iki.fi> to add
+	new constants and ftok
+	
+	fixed to compile with >5.004_50
+	
+	surrounded newCONSTSUB with #ifndef as perl now defines this itself
+
diff --git a/contrib/perl5/ext/IPC/SysV/MANIFEST b/contrib/perl5/ext/IPC/SysV/MANIFEST
new file mode 100644
index 0000000..4b2aa00
--- /dev/null
+++ b/contrib/perl5/ext/IPC/SysV/MANIFEST
@@ -0,0 +1,10 @@
+MANIFEST
+Makefile.PL
+Msg.pm
+README
+Semaphore.pm
+SysV.pm
+SysV.xs
+t/msg.t
+t/sem.t
+ChangeLog
diff --git a/contrib/perl5/ext/IPC/SysV/Makefile.PL b/contrib/perl5/ext/IPC/SysV/Makefile.PL
new file mode 100644
index 0000000..c8e320f
--- /dev/null
+++ b/contrib/perl5/ext/IPC/SysV/Makefile.PL
@@ -0,0 +1,36 @@
+# This -*- perl -*- script makes the Makefile
+# $Id: Makefile.PL,v 1.3 1997/03/04 09:21:12 gbarr Exp $
+
+require 5.002;
+use ExtUtils::MakeMaker;
+
+#--- MY package
+
+sub MY::libscan
+{
+ my($self,$path) = @_;
+
+ return '' 
+	if($path =~ m:/(RCS|CVS|SCCS)/: ||
+	   $path =~ m:[~%]$: ||
+	   $path =~ m:\.(orig|rej)$:
+	  );
+ 
+ $path;
+}
+
+WriteMakefile(
+	VERSION_FROM	=> "SysV.pm",
+	NAME      	=> "IPC::SysV",
+ 
+	'dist'    	=> {COMPRESS => 'gzip -9f',
+			    SUFFIX   => 'gz', 
+			    DIST_DEFAULT => 'all tardist',
+			   },
+ 
+	'clean'   	=> {FILES => join(" ",
+					map { "$_ */$_ */*/$_" }
+					qw(*% *.html *.b[ac]k *.old *.orig))
+			   },
+	'macro'		=> { INSTALLDIRS => 'perl' },
+);
diff --git a/contrib/perl5/ext/IPC/SysV/Msg.pm b/contrib/perl5/ext/IPC/SysV/Msg.pm
new file mode 100644
index 0000000..93d2ae1
--- /dev/null
+++ b/contrib/perl5/ext/IPC/SysV/Msg.pm
@@ -0,0 +1,223 @@
+# IPC::Msg.pm
+#
+# Copyright (c) 1997 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+package IPC::Msg;
+
+use IPC::SysV qw(IPC_STAT IPC_SET IPC_RMID);
+use strict;
+use vars qw($VERSION);
+use Carp;
+
+$VERSION = "1.00";
+
+{
+    package IPC::Msg::stat;
+
+    use Class::Struct qw(struct);
+
+    struct 'IPC::Msg::stat' => [
+	uid	=> '$',
+	gid	=> '$',
+	cuid	=> '$',
+	cgid	=> '$',
+	mode	=> '$',
+	qnum	=> '$',
+	qbytes	=> '$',
+	lspid	=> '$',
+	lrpid	=> '$',
+	stime	=> '$',
+	rtime	=> '$',
+	ctime	=> '$',
+    ];
+}
+
+sub new {
+    @_ == 3 || croak 'new IPC::Msg ( KEY , FLAGS )';
+    my $class = shift;
+
+    my $id = msgget($_[0],$_[1]);
+
+    defined($id)
+	? bless \$id, $class
+	: undef;
+}
+
+sub id {
+    my $self = shift;
+    $$self;
+}
+
+sub stat {
+    my $self = shift;
+    my $data = "";
+    msgctl($$self,IPC_STAT,$data) or
+	return undef;
+    IPC::Msg::stat->new->unpack($data);
+}
+
+sub set {
+    my $self = shift;
+    my $ds;
+
+    if(@_ == 1) {
+	$ds = shift;
+    }
+    else {
+	croak 'Bad arg count' if @_ % 2;
+	my %arg = @_;
+	my $ds = $self->stat
+		or return undef;
+	my($key,$val);
+	$ds->$key($val)
+	    while(($key,$val) = each %arg);
+    }
+
+    msgctl($$self,IPC_SET,$ds->pack);
+}
+
+sub remove {
+    my $self = shift;
+    (msgctl($$self,IPC_RMID,0), undef $$self)[0];
+}
+
+sub rcv {
+    @_ == 5 || croak '$msg->rcv( BUF, LEN, TYPE, FLAGS )';
+    my $self = shift;
+    my $buf = "";
+    msgrcv($$self,$buf,$_[1],$_[2] || 0, $_[3] || 0) or
+	return;
+    my $type;
+    ($type,$_[0]) = unpack("L a*",$buf);
+    $type;
+}
+
+sub snd {
+    @_ == 4 || croak '$msg->snd( TYPE, BUF, FLAGS )';
+    my $self = shift;
+    msgsnd($$self,pack("L a*",$_[0],$_[1]), $_[2] || 0);
+}
+
+
+1;
+
+__END__
+
+=head1 NAME
+
+IPC::Msg - SysV Msg IPC object class
+
+=head1 SYNOPSIS
+
+    use IPC::SysV qw(IPC_PRIVATE S_IRWXU S_IRWXG S_IRWXO);
+    use IPC::Msg;
+    
+    $msg = new IPC::Msg(IPC_PRIVATE, S_IRWXU | S_IRWXG | S_IRWXO);
+    
+    $msg->snd(pack("L a*",$msgtype,$msg));
+    
+    $msg->rcv($buf,256);
+    
+    $ds = $msg->stat;
+    
+    $msg->remove;
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=over 4
+
+=item new ( KEY , FLAGS )
+
+Creates a new message queue associated with C<KEY>. A new queue is
+created if
+
+=over 4
+
+=item *
+
+C<KEY> is equal to C<IPC_PRIVATE>
+
+=item *
+
+C<KEY> does not already  have  a  message queue
+associated with it, and C<I<FLAGS> & IPC_CREAT> is true.
+
+=back
+
+On creation of a new message queue C<FLAGS> is used to set the
+permissions.
+
+=item id
+
+Returns the system message queue identifier.
+
+=item rcv ( BUF, LEN [, TYPE [, FLAGS ]] )
+
+Read a message from the queue. Returns the type of the message read. See
+L<msgrcv>
+
+=item remove
+
+Remove and destroy the message queue from the system.
+
+=item set ( STAT )
+
+=item set ( NAME => VALUE [, NAME => VALUE ...] )
+
+C<set> will set the following values of the C<stat> structure associated
+with the message queue.
+
+    uid
+    gid
+    mode (oly the permission bits)
+    qbytes
+
+C<set> accepts either a stat object, as returned by the C<stat> method,
+or a list of I<name>-I<value> pairs.
+
+=item snd ( TYPE, MSG [, FLAGS ] )
+
+Place a message on the queue with the data from C<MSG> and with type C<TYPE>.
+See L<msgsnd>.
+
+=item stat
+
+Returns an object of type C<IPC::Msg::stat> which is a sub-class of
+C<Class::Struct>. It provides the following fields. For a description
+of these fields see you system documentation.
+
+    uid
+    gid
+    cuid
+    cgid
+    mode
+    qnum
+    qbytes
+    lspid
+    lrpid
+    stime
+    rtime
+    ctime
+
+=back
+
+=head1 SEE ALSO
+
+L<IPC::SysV> L<Class::Struct>
+
+=head1 AUTHOR
+
+Graham Barr <gbarr@pobox.com>
+
+=head1 COPYRIGHT
+
+Copyright (c) 1997 Graham Barr. All rights reserved.
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
diff --git a/contrib/perl5/ext/IPC/SysV/README b/contrib/perl5/ext/IPC/SysV/README
new file mode 100644
index 0000000..d412c4c
--- /dev/null
+++ b/contrib/perl5/ext/IPC/SysV/README
@@ -0,0 +1,20 @@
+Copyright (c) 1997 Graham Barr <gbarr@pobox.com>. All rights reserved.
+This package is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+The SysV-IPC contains three packages
+
+    IPC::Semaphore
+    - Provides an object interface to using SysV IPC semaphores
+
+    IPC::Msg
+    - Provides an object interface to using SysV IPC messages
+
+    IPC::SysV
+    - Provides the constants required to use the system SysV IPC calls.
+
+Currently there is not object support for SysV shared memory, but
+SysV::SharedMem is a project for the future.
+
+Share and enjoy!
+
diff --git a/contrib/perl5/ext/IPC/SysV/Semaphore.pm b/contrib/perl5/ext/IPC/SysV/Semaphore.pm
new file mode 100644
index 0000000..464eb0b
--- /dev/null
+++ b/contrib/perl5/ext/IPC/SysV/Semaphore.pm
@@ -0,0 +1,297 @@
+# IPC::Semaphore
+#
+# Copyright (c) 1997 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+package IPC::Semaphore;
+
+use IPC::SysV qw(GETNCNT GETZCNT GETVAL SETVAL GETPID GETALL SETALL
+		 IPC_STAT IPC_SET IPC_RMID);
+use strict;
+use vars qw($VERSION);
+use Carp;
+
+$VERSION = "1.00";
+
+{
+    package IPC::Semaphore::stat;
+
+    use Class::Struct qw(struct);
+
+    struct 'IPC::Semaphore::stat' => [
+	uid	=> '$',
+	gid	=> '$',
+	cuid	=> '$',
+	cgid	=> '$',
+	mode	=> '$',
+	ctime	=> '$',
+	otime	=> '$',
+	nsems	=> '$',
+    ];
+}
+
+sub new {
+    @_ == 4 || croak 'new ' . __PACKAGE__ . '( KEY, NSEMS, FLAGS )';
+    my $class = shift;
+
+    my $id = semget($_[0],$_[1],$_[2]);
+
+    defined($id)
+	? bless \$id, $class
+	: undef;
+}
+
+sub id {
+    my $self = shift;
+    $$self;
+}
+
+sub remove {
+    my $self = shift;
+    (semctl($$self,0,IPC_RMID,0), undef $$self)[0];
+}
+
+sub getncnt {
+    @_ == 2 || croak '$sem->getncnt( SEM )';
+    my $self = shift;
+    my $sem = shift;
+    my $v = semctl($$self,$sem,GETNCNT,0);
+    $v ? 0 + $v : undef;
+}
+
+sub getzcnt {
+    @_ == 2 || croak '$sem->getzcnt( SEM )';
+    my $self = shift;
+    my $sem = shift;
+    my $v = semctl($$self,$sem,GETZCNT,0);
+    $v ? 0 + $v : undef;
+}
+
+sub getval {
+    @_ == 2 || croak '$sem->getval( SEM )';
+    my $self = shift;
+    my $sem = shift;
+    my $v = semctl($$self,$sem,GETVAL,0);
+    $v ? 0 + $v : undef;
+}
+
+sub getpid {
+    @_ == 2 || croak '$sem->getpid( SEM )';
+    my $self = shift;
+    my $sem = shift;
+    my $v = semctl($$self,$sem,GETPID,0);
+    $v ? 0 + $v : undef;
+}
+
+sub op {
+    @_ >= 4 || croak '$sem->op( OPLIST )';
+    my $self = shift;
+    croak 'Bad arg count' if @_ % 3;
+    my $data = pack("s*",@_);
+    semop($$self,$data);
+}
+
+sub stat {
+    my $self = shift;
+    my $data = "";
+    semctl($$self,0,IPC_STAT,$data)
+	or return undef;
+    IPC::Semaphore::stat->new->unpack($data);
+}
+
+sub set {
+    my $self = shift;
+    my $ds;
+
+    if(@_ == 1) {
+	$ds = shift;
+    }
+    else {
+	croak 'Bad arg count' if @_ % 2;
+	my %arg = @_;
+	my $ds = $self->stat
+		or return undef;
+	my($key,$val);
+	$ds->$key($val)
+	    while(($key,$val) = each %arg);
+    }
+
+    my $v = semctl($$self,0,IPC_SET,$ds->pack);
+    $v ? 0 + $v : undef;
+}
+
+sub getall {
+    my $self = shift;
+    my $data = "";
+    semctl($$self,0,GETALL,$data)
+	or return ();
+    (unpack("s*",$data));
+}
+
+sub setall {
+    my $self = shift;
+    my $data = pack("s*",@_);
+    semctl($$self,0,SETALL,$data);
+}
+
+sub setval {
+    @_ == 3 || croak '$sem->setval( SEM, VAL )';
+    my $self = shift;
+    my $sem = shift;
+    my $val = shift;
+    semctl($$self,$sem,SETVAL,$val);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+IPC::Semaphore - SysV Semaphore IPC object class
+
+=head1 SYNOPSIS
+
+    use IPC::SysV qw(IPC_PRIVATE S_IRWXU IPC_CREAT);
+    use IPC::Semaphore;
+    
+    $sem = new IPC::Semaphore(IPC_PRIVATE, 10, S_IRWXU | IPC_CREAT);
+    
+    $sem->setall( (0) x 10);
+    
+    @sem = $sem->getall;
+    
+    $ncnt = $sem->getncnt;
+    
+    $zcnt = $sem->getzcnt;
+    
+    $ds = $sem->stat;
+    
+    $sem->remove;
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=over 4
+
+=item new ( KEY , NSEMS , FLAGS )
+
+Create a new semaphore set associated with C<KEY>. C<NSEMS> is the number
+of semaphores in the set. A new set is created if
+
+=over 4
+
+=item *
+
+C<KEY> is equal to C<IPC_PRIVATE>
+
+=item *
+
+C<KEY> does not already  have  a  semaphore  identifier
+associated with it, and C<I<FLAGS> & IPC_CREAT> is true.
+
+=back
+
+On creation of a new semaphore set C<FLAGS> is used to set the
+permissions.
+
+=item getall
+
+Returns the values of the semaphore set as an array.
+
+=item getncnt ( SEM )
+
+Returns the number of processed waiting for the semaphore C<SEM> to
+become greater than it's current value
+
+=item getpid ( SEM )
+
+Returns the process id of the last process that performed an operation
+on the semaphore C<SEM>.
+
+=item getval ( SEM )
+
+Returns the current value of the semaphore C<SEM>.
+
+=item getzcnt ( SEM )
+
+Returns the number of processed waiting for the semaphore C<SEM> to
+become zero.
+
+=item id
+
+Returns the system identifier for the semaphore set.
+
+=item op ( OPLIST )
+
+C<OPLIST> is a list of operations to pass to C<semop>. C<OPLIST> is
+a concatenation of smaller lists, each which has three values. The
+first is the semaphore number, the second is the operation and the last
+is a flags value. See L<semop> for more details. For example
+
+    $sem->op(
+	0, -1, IPC_NOWAIT,
+	1,  1, IPC_NOWAIT
+    );
+
+=item remove
+
+Remove and destroy the semaphore set from the system.
+
+=item set ( STAT )
+
+=item set ( NAME => VALUE [, NAME => VALUE ...] )
+
+C<set> will set the following values of the C<stat> structure associated
+with the semaphore set.
+
+    uid
+    gid
+    mode (oly the permission bits)
+
+C<set> accepts either a stat object, as returned by the C<stat> method,
+or a list of I<name>-I<value> pairs.
+
+=item setall ( VALUES )
+
+Sets all values in the semaphore set to those given on the C<VALUES> list.
+C<VALUES> must contain the correct number of values.
+
+=item setval ( N , VALUE )
+
+Set the C<N>th value in the semaphore set to C<VALUE>
+
+=item stat
+
+Returns an object of type C<IPC::Semaphore::stat> which is a sub-class of
+C<Class::Struct>. It provides the following fields. For a description
+of these fields see you system documentation.
+
+    uid
+    gid
+    cuid
+    cgid
+    mode
+    ctime
+    otime
+    nsems
+
+=back
+
+=head1 SEE ALSO
+
+L<IPC::SysV> L<Class::Struct> L<semget> L<semctl> L<semop> 
+
+=head1 AUTHOR
+
+Graham Barr <gbarr@pobox.com>
+
+=head1 COPYRIGHT
+
+Copyright (c) 1997 Graham Barr. All rights reserved.
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
diff --git a/contrib/perl5/ext/IPC/SysV/SysV.pm b/contrib/perl5/ext/IPC/SysV/SysV.pm
new file mode 100644
index 0000000..eb24593
--- /dev/null
+++ b/contrib/perl5/ext/IPC/SysV/SysV.pm
@@ -0,0 +1,98 @@
+# IPC::SysV.pm
+#
+# Copyright (c) 1997 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+package IPC::SysV;
+
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
+use Carp;
+use Config;
+
+require Exporter;
+@ISA = qw(Exporter);
+
+$VERSION = "1.03";
+
+@EXPORT_OK = qw(
+	GETALL GETNCNT GETPID GETVAL GETZCNT
+
+	IPC_ALLOC IPC_CREAT IPC_EXCL IPC_GETACL IPC_LOCKED IPC_M
+	IPC_NOERROR IPC_NOWAIT IPC_PRIVATE IPC_R IPC_RMID IPC_SET
+	IPC_SETACL IPC_SETLABEL IPC_STAT IPC_W IPC_WANTED
+
+	MSG_FWAIT MSG_LOCKED MSG_MWAIT MSG_NOERROR MSG_QWAIT
+	MSG_R MSG_RWAIT MSG_STAT MSG_W MSG_WWAIT
+
+	SEM_A SEM_ALLOC SEM_DEST SEM_ERR SEM_ORDER SEM_R SEM_UNDO
+
+	SETALL SETVAL
+
+	SHMLBA
+
+	SHM_A SHM_CLEAR SHM_COPY SHM_DCACHE SHM_DEST SHM_ECACHE
+	SHM_FMAP SHM_ICACHE SHM_INIT SHM_LOCK SHM_LOCKED SHM_MAP
+	SHM_NOSWAP SHM_R SHM_RDONLY SHM_REMOVED SHM_RND SHM_SHARE_MMU
+	SHM_SHATTR SHM_SIZE SHM_UNLOCK SHM_W
+
+	S_IRUSR S_IWUSR S_IRWXU
+	S_IRGRP S_IWGRP S_IRWXG
+	S_IROTH S_IWOTH S_IRWXO
+
+	ftok
+);
+
+BOOT_XS: {
+    # If I inherit DynaLoader then I inherit AutoLoader and I DON'T WANT TO
+    require DynaLoader;
+
+    # DynaLoader calls dl_load_flags as a static method.
+    *dl_load_flags = DynaLoader->can('dl_load_flags');
+
+    do {
+	__PACKAGE__->can('bootstrap') || \&DynaLoader::bootstrap
+    }->(__PACKAGE__, $VERSION);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+IPC::SysV - SysV IPC constants
+
+=head1 SYNOPSIS
+
+    use IPC::SysV qw(IPC_STAT IPC_PRIVATE);
+
+=head1 DESCRIPTION
+
+C<IPC::SysV> defines and conditionally exports all the constants
+defined in your system include files which are needed by the SysV
+IPC calls.
+
+=item ftok( PATH, ID )
+
+Return a key based on PATH and ID, which can be used as a key for
+C<msgget>, C<semget> and C<shmget>. See L<ftok>
+
+=head1 SEE ALSO
+
+L<IPC::Msg>, L<IPC::Semaphore>, L<ftok>
+
+=head1 AUTHORS
+
+Graham Barr <gbarr@pobox.com>
+Jarkko Hietaniemi <jhi@iki.fi>
+
+=head1 COPYRIGHT
+
+Copyright (c) 1997 Graham Barr. All rights reserved.
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
diff --git a/contrib/perl5/ext/IPC/SysV/SysV.xs b/contrib/perl5/ext/IPC/SysV/SysV.xs
new file mode 100644
index 0000000..0fbf783
--- /dev/null
+++ b/contrib/perl5/ext/IPC/SysV/SysV.xs
@@ -0,0 +1,423 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#include <sys/types.h>
+#ifdef __linux__
+#include <asm/page.h>
+#endif
+#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
+#include <sys/ipc.h>
+#ifdef HAS_MSG
+#include <sys/msg.h>
+#endif
+#ifdef HAS_SEM
+#include <sys/sem.h>
+#endif
+#ifdef HAS_SHM
+#if defined(PERL_SCO5) || defined(PERL_ISC)
+#include <sys/sysmacros.h>
+#endif
+#include <sys/shm.h>
+# ifndef HAS_SHMAT_PROTOTYPE
+    extern Shmat_t shmat _((int, char *, int));
+# endif
+#endif
+#endif
+
+/* Required in BSDI to get PAGE_SIZE definition for SHMLBA.
+ * Ugly.  More beautiful solutions welcome.
+ * Shouting at BSDI sounds quite beautiful. */
+#ifdef __bsdi__
+#   include <vm/vm_param.h>
+#endif
+
+MODULE=IPC::SysV	PACKAGE=IPC::Msg::stat
+
+PROTOTYPES: ENABLE
+
+void
+pack(obj)
+    SV	* obj
+PPCODE:
+{
+#ifdef HAS_MSG
+    SV *sv;
+    struct msqid_ds ds;
+    AV *list = (AV*)SvRV(obj);
+    sv = *av_fetch(list,0,TRUE); ds.msg_perm.uid = SvIV(sv);
+    sv = *av_fetch(list,1,TRUE); ds.msg_perm.gid = SvIV(sv);
+    sv = *av_fetch(list,4,TRUE); ds.msg_perm.mode = SvIV(sv);
+    sv = *av_fetch(list,6,TRUE); ds.msg_qbytes = SvIV(sv);
+    ST(0) = sv_2mortal(newSVpv((char *)&ds,sizeof(ds)));
+    XSRETURN(1);
+#else
+    croak("System V msgxxx is not implemented on this machine");
+#endif
+}
+
+void
+unpack(obj,buf)
+    SV * obj
+    SV * buf
+PPCODE:
+{
+#ifdef HAS_MSG
+    STRLEN len;
+    SV **sv_ptr;
+    struct msqid_ds *ds = (struct msqid_ds *)SvPV(buf,len);
+    AV *list = (AV*)SvRV(obj);
+    if (len != sizeof(*ds)) {
+	croak("Bad arg length for %s, length is %d, should be %d",
+		    "IPC::Msg::stat",
+		    len, sizeof(*ds));
+    }
+    sv_ptr = av_fetch(list,0,TRUE);
+    sv_setiv(*sv_ptr, ds->msg_perm.uid);
+    sv_ptr = av_fetch(list,1,TRUE);
+    sv_setiv(*sv_ptr, ds->msg_perm.gid);
+    sv_ptr = av_fetch(list,2,TRUE);
+    sv_setiv(*sv_ptr, ds->msg_perm.cuid);
+    sv_ptr = av_fetch(list,3,TRUE);
+    sv_setiv(*sv_ptr, ds->msg_perm.cgid);
+    sv_ptr = av_fetch(list,4,TRUE);
+    sv_setiv(*sv_ptr, ds->msg_perm.mode);
+    sv_ptr = av_fetch(list,5,TRUE);
+    sv_setiv(*sv_ptr, ds->msg_qnum);
+    sv_ptr = av_fetch(list,6,TRUE);
+    sv_setiv(*sv_ptr, ds->msg_qbytes);
+    sv_ptr = av_fetch(list,7,TRUE);
+    sv_setiv(*sv_ptr, ds->msg_lspid);
+    sv_ptr = av_fetch(list,8,TRUE);
+    sv_setiv(*sv_ptr, ds->msg_lrpid);
+    sv_ptr = av_fetch(list,9,TRUE);
+    sv_setiv(*sv_ptr, ds->msg_stime);
+    sv_ptr = av_fetch(list,10,TRUE);
+    sv_setiv(*sv_ptr, ds->msg_rtime);
+    sv_ptr = av_fetch(list,11,TRUE);
+    sv_setiv(*sv_ptr, ds->msg_ctime);
+    XSRETURN(1);
+#else
+    croak("System V msgxxx is not implemented on this machine");
+#endif
+}
+
+MODULE=IPC::SysV	PACKAGE=IPC::Semaphore::stat
+
+void
+unpack(obj,ds)
+    SV * obj
+    SV * ds
+PPCODE:
+{
+#ifdef HAS_SEM
+    STRLEN len;
+    AV *list = (AV*)SvRV(obj);
+    struct semid_ds *data = (struct semid_ds *)SvPV(ds,len);
+    if(!sv_isa(obj, "IPC::Semaphore::stat"))
+	croak("method %s not called a %s object",
+		"unpack","IPC::Semaphore::stat");
+    if (len != sizeof(*data)) {
+	croak("Bad arg length for %s, length is %d, should be %d",
+		    "IPC::Semaphore::stat",
+		    len, sizeof(*data));
+    }
+    sv_setiv(*av_fetch(list,0,TRUE), data[0].sem_perm.uid);
+    sv_setiv(*av_fetch(list,1,TRUE), data[0].sem_perm.gid);
+    sv_setiv(*av_fetch(list,2,TRUE), data[0].sem_perm.cuid);
+    sv_setiv(*av_fetch(list,3,TRUE), data[0].sem_perm.cgid);
+    sv_setiv(*av_fetch(list,4,TRUE), data[0].sem_perm.mode);
+    sv_setiv(*av_fetch(list,5,TRUE), data[0].sem_ctime);
+    sv_setiv(*av_fetch(list,6,TRUE), data[0].sem_otime);
+    sv_setiv(*av_fetch(list,7,TRUE), data[0].sem_nsems);
+    XSRETURN(1);
+#else
+    croak("System V semxxx is not implemented on this machine");
+#endif
+}
+
+void
+pack(obj)
+    SV	* obj
+PPCODE:
+{
+#ifdef HAS_SEM
+    SV **sv_ptr;
+    SV *sv;
+    struct semid_ds ds;
+    AV *list = (AV*)SvRV(obj);
+    if(!sv_isa(obj, "IPC::Semaphore::stat"))
+	croak("method %s not called a %s object",
+		"pack","IPC::Semaphore::stat");
+    if((sv_ptr = av_fetch(list,0,TRUE)) && (sv = *sv_ptr))
+	ds.sem_perm.uid = SvIV(*sv_ptr);
+    if((sv_ptr = av_fetch(list,1,TRUE)) && (sv = *sv_ptr))
+	ds.sem_perm.gid = SvIV(*sv_ptr);
+    if((sv_ptr = av_fetch(list,2,TRUE)) && (sv = *sv_ptr))
+	ds.sem_perm.cuid = SvIV(*sv_ptr);
+    if((sv_ptr = av_fetch(list,3,TRUE)) && (sv = *sv_ptr))
+	ds.sem_perm.cgid = SvIV(*sv_ptr);
+    if((sv_ptr = av_fetch(list,4,TRUE)) && (sv = *sv_ptr))
+	ds.sem_perm.mode = SvIV(*sv_ptr);
+    if((sv_ptr = av_fetch(list,5,TRUE)) && (sv = *sv_ptr))
+	ds.sem_ctime = SvIV(*sv_ptr);
+    if((sv_ptr = av_fetch(list,6,TRUE)) && (sv = *sv_ptr))
+	ds.sem_otime = SvIV(*sv_ptr);
+    if((sv_ptr = av_fetch(list,7,TRUE)) && (sv = *sv_ptr))
+	ds.sem_nsems = SvIV(*sv_ptr);
+    ST(0) = sv_2mortal(newSVpv((char *)&ds,sizeof(ds)));
+    XSRETURN(1);
+#else
+    croak("System V semxxx is not implemented on this machine");
+#endif
+}
+
+MODULE=IPC::SysV	PACKAGE=IPC::SysV
+
+int
+ftok(path, id)
+        char *          path
+        int             id
+    CODE:
+#if defined(HAS_SEM) || defined(HAS_SHM)
+        key_t k = ftok(path, id);
+        ST(0) = k == (key_t) -1 ? &PL_sv_undef : sv_2mortal(newSViv(k));
+#else
+        DIE(no_func, "ftok");
+#endif
+
+int
+SHMLBA()
+    CODE:
+#ifdef SHMLBA
+    ST(0) = sv_2mortal(newSViv(SHMLBA));
+#else
+    croak("SHMLBA is not defined on this architecture");
+#endif
+
+BOOT:
+{
+    HV *stash = gv_stashpvn("IPC::SysV", 9, TRUE);
+    /*
+     * constant subs for IPC::SysV
+     */
+     struct { char *n; I32 v; } IPC__SysV__const[] = {
+#ifdef GETVAL
+        {"GETVAL", GETVAL},
+#endif
+#ifdef GETPID
+        {"GETPID", GETPID},
+#endif
+#ifdef GETNCNT
+        {"GETNCNT", GETNCNT},
+#endif
+#ifdef GETZCNT
+        {"GETZCNT", GETZCNT},
+#endif
+#ifdef GETALL
+        {"GETALL", GETALL},
+#endif
+#ifdef IPC_ALLOC
+        {"IPC_ALLOC", IPC_ALLOC},
+#endif
+#ifdef IPC_CREAT
+        {"IPC_CREAT", IPC_CREAT},
+#endif
+#ifdef IPC_EXCL
+        {"IPC_EXCL", IPC_EXCL},
+#endif
+#ifdef IPC_GETACL
+        {"IPC_GETACL", IPC_EXCL},
+#endif
+#ifdef IPC_LOCKED
+        {"IPC_LOCKED", IPC_LOCKED},
+#endif
+#ifdef IPC_M
+        {"IPC_M", IPC_M},
+#endif
+#ifdef IPC_NOERROR
+        {"IPC_NOERROR", IPC_NOERROR},
+#endif
+#ifdef IPC_NOWAIT
+        {"IPC_NOWAIT", IPC_NOWAIT},
+#endif
+#ifdef IPC_PRIVATE
+        {"IPC_PRIVATE", IPC_PRIVATE},
+#endif
+#ifdef IPC_R
+        {"IPC_R", IPC_R},
+#endif
+#ifdef IPC_RMID
+        {"IPC_RMID", IPC_RMID},
+#endif
+#ifdef IPC_SET
+        {"IPC_SET", IPC_SET},
+#endif
+#ifdef IPC_SETACL
+        {"IPC_SETACL", IPC_SETACL},
+#endif
+#ifdef IPC_SETLABEL
+        {"IPC_SETLABEL", IPC_SETLABEL},
+#endif
+#ifdef IPC_STAT
+        {"IPC_STAT", IPC_STAT},
+#endif
+#ifdef IPC_W
+        {"IPC_W", IPC_W},
+#endif
+#ifdef IPC_WANTED
+        {"IPC_WANTED", IPC_WANTED},
+#endif
+#ifdef MSG_NOERROR
+        {"MSG_NOERROR", MSG_NOERROR},
+#endif
+#ifdef MSG_FWAIT
+        {"MSG_FWAIT", MSG_FWAIT},
+#endif
+#ifdef MSG_LOCKED
+        {"MSG_LOCKED", MSG_LOCKED},
+#endif
+#ifdef MSG_MWAIT
+        {"MSG_MWAIT", MSG_MWAIT},
+#endif
+#ifdef MSG_WAIT
+        {"MSG_WAIT", MSG_WAIT},
+#endif
+#ifdef MSG_R
+        {"MSG_R", MSG_R},
+#endif
+#ifdef MSG_RWAIT
+        {"MSG_RWAIT", MSG_RWAIT},
+#endif
+#ifdef MSG_STAT
+        {"MSG_STAT", MSG_STAT},
+#endif
+#ifdef MSG_W
+        {"MSG_W", MSG_W},
+#endif
+#ifdef MSG_WWAIT
+        {"MSG_WWAIT", MSG_WWAIT},
+#endif
+#ifdef SEM_A
+        {"SEM_A", SEM_A},
+#endif
+#ifdef SEM_ALLOC
+        {"SEM_ALLOC", SEM_ALLOC},
+#endif
+#ifdef SEM_DEST
+        {"SEM_DEST", SEM_DEST},
+#endif
+#ifdef SEM_ERR
+        {"SEM_ERR", SEM_ERR},
+#endif
+#ifdef SEM_R
+        {"SEM_R", SEM_R},
+#endif
+#ifdef SEM_ORDER
+        {"SEM_ORDER", SEM_ORDER},
+#endif
+#ifdef SEM_UNDO
+        {"SEM_UNDO", SEM_UNDO},
+#endif
+#ifdef SETVAL
+        {"SETVAL", SETVAL},
+#endif
+#ifdef SETALL
+        {"SETALL", SETALL},
+#endif
+#ifdef SHM_CLEAR
+        {"SHM_CLEAR", SHM_CLEAR},
+#endif
+#ifdef SHM_COPY
+        {"SHM_COPY", SHM_COPY},
+#endif
+#ifdef SHM_DCACHE
+        {"SHM_DCACHE", SHM_DCACHE},
+#endif
+#ifdef SHM_DEST
+        {"SHM_DEST", SHM_DEST},
+#endif
+#ifdef SHM_ECACHE
+        {"SHM_ECACHE", SHM_ECACHE},
+#endif
+#ifdef SHM_FMAP
+        {"SHM_FMAP", SHM_FMAP},
+#endif
+#ifdef SHM_ICACHE
+        {"SHM_ICACHE", SHM_ICACHE},
+#endif
+#ifdef SHM_INIT
+        {"SHM_INIT", SHM_INIT},
+#endif
+#ifdef SHM_LOCK
+        {"SHM_LOCK", SHM_LOCK},
+#endif
+#ifdef SHM_LOCKED
+        {"SHM_LOCKED", SHM_LOCKED},
+#endif
+#ifdef SHM_MAP
+        {"SHM_MAP", SHM_MAP},
+#endif
+#ifdef SHM_NOSWAP
+        {"SHM_NOSWAP", SHM_NOSWAP},
+#endif
+#ifdef SHM_RDONLY
+        {"SHM_RDONLY", SHM_RDONLY},
+#endif
+#ifdef SHM_REMOVED
+        {"SHM_REMOVED", SHM_REMOVED},
+#endif
+#ifdef SHM_RND
+        {"SHM_RND", SHM_RND},
+#endif
+#ifdef SHM_SHARE_MMU
+        {"SHM_SHARE_MMU", SHM_SHARE_MMU},
+#endif
+#ifdef SHM_SHATTR
+        {"SHM_SHATTR", SHM_SHATTR},
+#endif
+#ifdef SHM_SIZE
+        {"SHM_SIZE", SHM_SIZE},
+#endif
+#ifdef SHM_UNLOCK
+        {"SHM_UNLOCK", SHM_UNLOCK},
+#endif
+#ifdef SHM_W
+        {"SHM_W", SHM_W},
+#endif
+#ifdef S_IRUSR
+        {"S_IRUSR", S_IRUSR},
+#endif
+#ifdef S_IWUSR
+        {"S_IWUSR", S_IWUSR},
+#endif
+#ifdef S_IRWXU
+        {"S_IRWXU", S_IRWXU},
+#endif
+#ifdef S_IRGRP
+        {"S_IRGRP", S_IRGRP},
+#endif
+#ifdef S_IWGRP
+        {"S_IWGRP", S_IWGRP},
+#endif
+#ifdef S_IRWXG
+        {"S_IRWXG", S_IRWXG},
+#endif
+#ifdef S_IROTH
+        {"S_IROTH", S_IROTH},
+#endif
+#ifdef S_IWOTH
+        {"S_IWOTH", S_IWOTH},
+#endif
+#ifdef S_IRWXO
+        {"S_IRWXO", S_IRWXO},
+#endif
+	{Nullch,0}};
+    char *name;
+    int i;
+
+    for(i = 0 ; name = IPC__SysV__const[i].n ; i++) {
+	newCONSTSUB(stash,name, newSViv(IPC__SysV__const[i].v));
+    }
+}
+
diff --git a/contrib/perl5/ext/IPC/SysV/t/msg.t b/contrib/perl5/ext/IPC/SysV/t/msg.t
new file mode 100755
index 0000000..2a982f0
--- /dev/null
+++ b/contrib/perl5/ext/IPC/SysV/t/msg.t
@@ -0,0 +1,41 @@
+use IPC::SysV qw(IPC_PRIVATE IPC_RMID IPC_NOWAIT IPC_STAT S_IRWXU S_IRWXG S_IRWXO);
+
+use IPC::Msg;
+#Creating a message queue
+
+print "1..9\n";
+
+$msq = new IPC::Msg(IPC_PRIVATE, S_IRWXU | S_IRWXG | S_IRWXO)
+	|| die "msgget: ",$!+0," $!\n";
+	
+print "ok 1\n";
+
+#Putting a message on the queue
+$msgtype = 1;
+$msg = "hello";
+$msq->snd($msgtype,$msg,0) || print "not ";
+print "ok 2\n";
+
+#Check if there are messages on the queue
+$ds = $msq->stat() or print "not ";
+print "ok 3\n";
+
+print "not " unless $ds && $ds->qnum() == 1;
+print "ok 4\n";
+
+#Retreiving a message from the queue
+$rmsgtype = 0; # Give me any type
+$rmsgtype = $msq->rcv($rmsg,256,$rmsgtype,IPC_NOWAIT) || print "not ";
+print "ok 5\n";
+
+print "not " unless $rmsgtype == $msgtype && $rmsg eq $msg;
+print "ok 6\n";
+
+$ds = $msq->stat() or print "not ";
+print "ok 7\n";
+
+print "not " unless $ds && $ds->qnum() == 0;
+print "ok 8\n";
+
+$msq->remove || print "not ";
+print "ok 9\n";
diff --git a/contrib/perl5/ext/IPC/SysV/t/sem.t b/contrib/perl5/ext/IPC/SysV/t/sem.t
new file mode 100755
index 0000000..9d6fff6
--- /dev/null
+++ b/contrib/perl5/ext/IPC/SysV/t/sem.t
@@ -0,0 +1,51 @@
+
+use IPC::SysV qw(
+	SETALL
+	IPC_PRIVATE
+	IPC_CREAT
+	IPC_RMID
+	IPC_NOWAIT
+	IPC_STAT
+	S_IRWXU
+	S_IRWXG
+	S_IRWXO
+);
+use IPC::Semaphore;
+
+print "1..10\n";
+
+$sem = new IPC::Semaphore(IPC_PRIVATE, 10, S_IRWXU | S_IRWXG | S_IRWXO | IPC_CREAT)
+	|| die "semget: ",$!+0," $!\n";
+
+print "ok 1\n";
+
+my $st = $sem->stat || print "not ";
+print "ok 2\n";
+
+$sem->setall( (0) x 10) || print "not ";
+print "ok 3\n";
+
+my @sem = $sem->getall;
+print "not " unless join("",@sem) eq "0000000000";
+print "ok 4\n";
+
+$sem[2] = 1;
+$sem->setall( @sem ) || print "not ";
+print "ok 5\n";
+
+@sem = $sem->getall;
+print "not " unless join("",@sem) eq "0010000000";
+print "ok 6\n";
+
+my $ncnt = $sem->getncnt(0);
+print "not " if $sem->getncnt(0) || !defined($ncnt);
+print "ok 7\n";
+
+$sem->op(2,-1,IPC_NOWAIT) || print "not ";
+print "ok 8\n";
+
+print "not " if $sem->getncnt(0);
+print "ok 9\n";
+
+$sem->remove || print "not ";
+print "ok 10\n";
diff --git a/contrib/perl5/ext/NDBM_File/Makefile.PL b/contrib/perl5/ext/NDBM_File/Makefile.PL
new file mode 100644
index 0000000..ca4c107
--- /dev/null
+++ b/contrib/perl5/ext/NDBM_File/Makefile.PL
@@ -0,0 +1,8 @@
+use ExtUtils::MakeMaker;
+WriteMakefile(
+    NAME	=> 'NDBM_File',
+    LIBS => ["-L/usr/local/lib -lndbm", "-ldbm -lucb"],
+    MAN3PODS 	=> ' ', 	# Pods will be built by installman.
+    XSPROTOARG => '-noprototypes', 		# XXX remove later?
+    VERSION_FROM => 'NDBM_File.pm',
+);
diff --git a/contrib/perl5/ext/NDBM_File/NDBM_File.pm b/contrib/perl5/ext/NDBM_File/NDBM_File.pm
new file mode 100644
index 0000000..ed4fe2b
--- /dev/null
+++ b/contrib/perl5/ext/NDBM_File/NDBM_File.pm
@@ -0,0 +1,40 @@
+package NDBM_File;
+
+BEGIN {
+    if ($] >= 5.002) {
+	use strict;
+    }
+}
+use vars qw($VERSION @ISA); 
+
+require Tie::Hash;
+require DynaLoader;
+
+@ISA = qw(Tie::Hash DynaLoader);
+
+$VERSION = "1.01";
+
+bootstrap NDBM_File $VERSION;
+
+1;
+
+__END__
+
+=head1 NAME
+
+NDBM_File - Tied access to ndbm files
+
+=head1 SYNOPSIS
+
+ use NDBM_File;
+ use Fcntl;       # for O_ constants
+
+ tie(%h, 'NDBM_File', 'Op.dbmx', O_RDWR|O_CREAT, 0640);
+
+ untie %h;
+
+=head1 DESCRIPTION
+
+See L<perlfunc/tie>
+
+=cut
diff --git a/contrib/perl5/ext/NDBM_File/NDBM_File.xs b/contrib/perl5/ext/NDBM_File/NDBM_File.xs
new file mode 100644
index 0000000..d129a9c
--- /dev/null
+++ b/contrib/perl5/ext/NDBM_File/NDBM_File.xs
@@ -0,0 +1,70 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#include <ndbm.h>
+
+typedef DBM* NDBM_File;
+#define dbm_TIEHASH(dbtype,filename,flags,mode) dbm_open(filename,flags,mode)
+#define dbm_FETCH(db,key)			dbm_fetch(db,key)
+#define dbm_STORE(db,key,value,flags)		dbm_store(db,key,value,flags)
+#define dbm_DELETE(db,key)			dbm_delete(db,key)
+#define dbm_FIRSTKEY(db)			dbm_firstkey(db)
+#define dbm_NEXTKEY(db,key)			dbm_nextkey(db)
+
+MODULE = NDBM_File	PACKAGE = NDBM_File	PREFIX = dbm_
+
+NDBM_File
+dbm_TIEHASH(dbtype, filename, flags, mode)
+	char *		dbtype
+	char *		filename
+	int		flags
+	int		mode
+
+void
+dbm_DESTROY(db)
+	NDBM_File	db
+	CODE:
+	dbm_close(db);
+
+datum
+dbm_FETCH(db, key)
+	NDBM_File	db
+	datum		key
+
+int
+dbm_STORE(db, key, value, flags = DBM_REPLACE)
+	NDBM_File	db
+	datum		key
+	datum		value
+	int		flags
+    CLEANUP:
+	if (RETVAL) {
+	    if (RETVAL < 0 && errno == EPERM)
+		croak("No write permission to ndbm file");
+	    croak("ndbm store returned %d, errno %d, key \"%s\"",
+			RETVAL,errno,key.dptr);
+	    dbm_clearerr(db);
+	}
+
+int
+dbm_DELETE(db, key)
+	NDBM_File	db
+	datum		key
+
+datum
+dbm_FIRSTKEY(db)
+	NDBM_File	db
+
+datum
+dbm_NEXTKEY(db, key)
+	NDBM_File	db
+	datum		key
+
+int
+dbm_error(db)
+	NDBM_File	db
+
+void
+dbm_clearerr(db)
+	NDBM_File	db
+
diff --git a/contrib/perl5/ext/NDBM_File/hints/dec_osf.pl b/contrib/perl5/ext/NDBM_File/hints/dec_osf.pl
new file mode 100644
index 0000000..e96d907
--- /dev/null
+++ b/contrib/perl5/ext/NDBM_File/hints/dec_osf.pl
@@ -0,0 +1,2 @@
+#   Spider Boardman  <spider@Orb.Nashua.NH.US>
+$self->{LIBS} = [''];
diff --git a/contrib/perl5/ext/NDBM_File/hints/dynixptx.pl b/contrib/perl5/ext/NDBM_File/hints/dynixptx.pl
new file mode 100644
index 0000000..d402c17
--- /dev/null
+++ b/contrib/perl5/ext/NDBM_File/hints/dynixptx.pl
@@ -0,0 +1,3 @@
+# On DYNIX/ptx 4.0 (v4.1.3), ndbm is actually contained in the 
+# libc library, and must be explicitly linked against -lc when compiling.
+$self->{LIBS} = ['-lc'];
diff --git a/contrib/perl5/ext/NDBM_File/hints/solaris.pl b/contrib/perl5/ext/NDBM_File/hints/solaris.pl
new file mode 100644
index 0000000..11310a9
--- /dev/null
+++ b/contrib/perl5/ext/NDBM_File/hints/solaris.pl
@@ -0,0 +1,3 @@
+# -lucb has been reported to be fatal for perl5 on Solaris.
+# Thus we deliberately don't include it here.
+$self->{LIBS} = ["-lndbm", "-ldbm"];
diff --git a/contrib/perl5/ext/NDBM_File/hints/svr4.pl b/contrib/perl5/ext/NDBM_File/hints/svr4.pl
new file mode 100644
index 0000000..3285d9a
--- /dev/null
+++ b/contrib/perl5/ext/NDBM_File/hints/svr4.pl
@@ -0,0 +1,4 @@
+# Some SVR4 systems may need to link against routines in -lucb for
+# odbm.  Some may also need to link against -lc to pick up things like
+# ecvt.
+$self->{LIBS} = ['-ldbm -lucb -lc'];
diff --git a/contrib/perl5/ext/NDBM_File/typemap b/contrib/perl5/ext/NDBM_File/typemap
new file mode 100644
index 0000000..317a8f3
--- /dev/null
+++ b/contrib/perl5/ext/NDBM_File/typemap
@@ -0,0 +1,27 @@
+#
+#################################### DBM SECTION
+#
+
+datum			T_DATUM
+gdatum			T_GDATUM
+NDBM_File		T_PTROBJ
+GDBM_File		T_PTROBJ
+SDBM_File		T_PTROBJ
+ODBM_File		T_PTROBJ
+DB_File			T_PTROBJ
+DBZ_File		T_PTROBJ
+FATALFUNC		T_OPAQUEPTR
+
+INPUT
+T_DATUM
+	$var.dptr = SvPV($arg, PL_na);
+	$var.dsize = (int)PL_na;
+T_GDATUM
+	UNIMPLEMENTED
+OUTPUT
+T_DATUM
+	sv_setpvn($arg, $var.dptr, $var.dsize);
+T_GDATUM
+	sv_usepvn($arg, $var.dptr, $var.dsize);
+T_PTROBJ
+        sv_setref_pv($arg, dbtype, (void*)$var);
diff --git a/contrib/perl5/ext/ODBM_File/Makefile.PL b/contrib/perl5/ext/ODBM_File/Makefile.PL
new file mode 100644
index 0000000..76a5d19
--- /dev/null
+++ b/contrib/perl5/ext/ODBM_File/Makefile.PL
@@ -0,0 +1,8 @@
+use ExtUtils::MakeMaker;
+WriteMakefile(
+    NAME	=> 'ODBM_File',
+    LIBS => ["-ldbm -lucb"],
+    MAN3PODS 	=> ' ', 	# Pods will be built by installman.
+    XSPROTOARG => '-noprototypes', 		# XXX remove later?
+    VERSION_FROM => 'ODBM_File.pm', 
+);
diff --git a/contrib/perl5/ext/ODBM_File/ODBM_File.pm b/contrib/perl5/ext/ODBM_File/ODBM_File.pm
new file mode 100644
index 0000000..923640f
--- /dev/null
+++ b/contrib/perl5/ext/ODBM_File/ODBM_File.pm
@@ -0,0 +1,35 @@
+package ODBM_File;
+
+use strict;
+use vars qw($VERSION @ISA);
+
+require Tie::Hash;
+require DynaLoader;
+
+@ISA = qw(Tie::Hash DynaLoader);
+
+$VERSION = "1.00";
+
+bootstrap ODBM_File $VERSION;
+
+1;
+
+__END__
+
+=head1 NAME
+
+ODBM_File - Tied access to odbm files
+
+=head1 SYNOPSIS
+
+ use ODBM_File;
+
+ tie(%h, 'ODBM_File', 'Op.dbmx', O_RDWR|O_CREAT, 0640);
+
+ untie %h;
+
+=head1 DESCRIPTION
+
+See L<perlfunc/tie>
+
+=cut
diff --git a/contrib/perl5/ext/ODBM_File/ODBM_File.xs b/contrib/perl5/ext/ODBM_File/ODBM_File.xs
new file mode 100644
index 0000000..892c038
--- /dev/null
+++ b/contrib/perl5/ext/ODBM_File/ODBM_File.xs
@@ -0,0 +1,122 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#ifdef NULL
+#undef NULL  /* XXX Why? */
+#endif
+#ifdef I_DBM
+#  include <dbm.h>
+#else
+#  ifdef I_RPCSVC_DBM
+#    include <rpcsvc/dbm.h>
+#  endif
+#endif
+
+#ifdef DBM_BUG_DUPLICATE_FREE 
+/*
+ * DBM on at least Ultrix and HPUX call dbmclose() from dbminit(),
+ * resulting in duplicate free() because dbmclose() does *not*
+ * check if it has already been called for this DBM.
+ * If some malloc/free calls have been done between dbmclose() and
+ * the next dbminit(), the memory might be used for something else when
+ * it is freed.
+ * Verified to work on ultrix4.3.  Probably will work on HP/UX.
+ * Set DBM_BUG_DUPLICATE_FREE in the extension hint file.
+ */
+/* Close the previous dbm, and fail to open a new dbm */
+#define dbmclose()	((void) dbminit("/tmp/x/y/z/z/y"))
+#endif
+
+#include <fcntl.h>
+
+typedef void* ODBM_File;
+
+#define odbm_FETCH(db,key)			fetch(key)
+#define odbm_STORE(db,key,value,flags)		store(key,value)
+#define odbm_DELETE(db,key)			delete(key)
+#define odbm_FIRSTKEY(db)			firstkey()
+#define odbm_NEXTKEY(db,key)			nextkey(key)
+
+static int dbmrefcnt;
+
+#ifndef DBM_REPLACE
+#define DBM_REPLACE 0
+#endif
+
+MODULE = ODBM_File	PACKAGE = ODBM_File	PREFIX = odbm_
+
+#ifndef NULL
+#  define NULL 0
+#endif
+
+ODBM_File
+odbm_TIEHASH(dbtype, filename, flags, mode)
+	char *		dbtype
+	char *		filename
+	int		flags
+	int		mode
+	CODE:
+	{
+	    char *tmpbuf;
+	    if (dbmrefcnt++)
+		croak("Old dbm can only open one database");
+	    New(0, tmpbuf, strlen(filename) + 5, char);
+	    SAVEFREEPV(tmpbuf);
+	    sprintf(tmpbuf,"%s.dir",filename);
+	    if (stat(tmpbuf, &PL_statbuf) < 0) {
+		if (flags & O_CREAT) {
+		    if (mode < 0 || close(creat(tmpbuf,mode)) < 0)
+			croak("ODBM_File: Can't create %s", filename);
+		    sprintf(tmpbuf,"%s.pag",filename);
+		    if (close(creat(tmpbuf,mode)) < 0)
+			croak("ODBM_File: Can't create %s", filename);
+		}
+		else
+		    croak("ODBM_FILE: Can't open %s", filename);
+	    }
+	    RETVAL = (void*)(dbminit(filename) >= 0 ? &dbmrefcnt : 0);
+	    ST(0) = sv_mortalcopy(&PL_sv_undef);
+	    sv_setptrobj(ST(0), RETVAL, dbtype);
+	}
+
+void
+DESTROY(db)
+	ODBM_File	db
+	CODE:
+	dbmrefcnt--;
+	dbmclose();
+
+datum
+odbm_FETCH(db, key)
+	ODBM_File	db
+	datum		key
+
+int
+odbm_STORE(db, key, value, flags = DBM_REPLACE)
+	ODBM_File	db
+	datum		key
+	datum		value
+	int		flags
+    CLEANUP:
+	if (RETVAL) {
+	    if (RETVAL < 0 && errno == EPERM)
+		croak("No write permission to odbm file");
+	    croak("odbm store returned %d, errno %d, key \"%s\"",
+			RETVAL,errno,key.dptr);
+	}
+
+int
+odbm_DELETE(db, key)
+	ODBM_File	db
+	datum		key
+
+datum
+odbm_FIRSTKEY(db)
+	ODBM_File	db
+
+datum
+odbm_NEXTKEY(db, key)
+	ODBM_File	db
+	datum		key
+
diff --git a/contrib/perl5/ext/ODBM_File/hints/dec_osf.pl b/contrib/perl5/ext/ODBM_File/hints/dec_osf.pl
new file mode 100644
index 0000000..febb7cd
--- /dev/null
+++ b/contrib/perl5/ext/ODBM_File/hints/dec_osf.pl
@@ -0,0 +1,9 @@
+# The -hidden option causes compilation to fail on Digital Unix.
+#   Andy Dougherty  <doughera@lafcol.lafayette.edu>
+#   Sat Jan 13 16:29:52 EST 1996
+$self->{LDDLFLAGS} = $Config{lddlflags};
+$self->{LDDLFLAGS} =~ s/-hidden//;
+#  As long as we're hinting, note the known location of the dbm routines.
+#   Spider Boardman  <spider@Orb.Nashua.NH.US>
+#   Fri Feb 21 14:50:31 EST 1997
+$self->{LIBS} = ['-ldbm'];
diff --git a/contrib/perl5/ext/ODBM_File/hints/hpux.pl b/contrib/perl5/ext/ODBM_File/hints/hpux.pl
new file mode 100644
index 0000000..31f9d24
--- /dev/null
+++ b/contrib/perl5/ext/ODBM_File/hints/hpux.pl
@@ -0,0 +1,4 @@
+#  Try to work around "bad free" messages.  See note in ODBM_File.xs.
+#   Andy Dougherty  <doughera@lafcol.lafayette.edu>
+#   Sun Sep  8 12:57:52 EDT 1996
+$self->{CCFLAGS} = $Config{ccflags} . ' -DDBM_BUG_DUPLICATE_FREE' ;
diff --git a/contrib/perl5/ext/ODBM_File/hints/sco.pl b/contrib/perl5/ext/ODBM_File/hints/sco.pl
new file mode 100644
index 0000000..4664f2b
--- /dev/null
+++ b/contrib/perl5/ext/ODBM_File/hints/sco.pl
@@ -0,0 +1,4 @@
+# Some versions of SCO contain a broken -ldbm library that is missing
+# dbmclose.  Some of those might have a fixed library installed as
+# -ldbm.nfs.
+$self->{LIBS} = ['-ldbm.nfs', '-ldbm'];
diff --git a/contrib/perl5/ext/ODBM_File/hints/solaris.pl b/contrib/perl5/ext/ODBM_File/hints/solaris.pl
new file mode 100644
index 0000000..ac57393
--- /dev/null
+++ b/contrib/perl5/ext/ODBM_File/hints/solaris.pl
@@ -0,0 +1,3 @@
+# -lucb has been reported to be fatal for perl5 on Solaris.
+# Thus we deliberately don't include it here.
+$self->{LIBS} = ['-ldbm'];
diff --git a/contrib/perl5/ext/ODBM_File/hints/svr4.pl b/contrib/perl5/ext/ODBM_File/hints/svr4.pl
new file mode 100644
index 0000000..3285d9a
--- /dev/null
+++ b/contrib/perl5/ext/ODBM_File/hints/svr4.pl
@@ -0,0 +1,4 @@
+# Some SVR4 systems may need to link against routines in -lucb for
+# odbm.  Some may also need to link against -lc to pick up things like
+# ecvt.
+$self->{LIBS} = ['-ldbm -lucb -lc'];
diff --git a/contrib/perl5/ext/ODBM_File/hints/ultrix.pl b/contrib/perl5/ext/ODBM_File/hints/ultrix.pl
new file mode 100644
index 0000000..31f9d24
--- /dev/null
+++ b/contrib/perl5/ext/ODBM_File/hints/ultrix.pl
@@ -0,0 +1,4 @@
+#  Try to work around "bad free" messages.  See note in ODBM_File.xs.
+#   Andy Dougherty  <doughera@lafcol.lafayette.edu>
+#   Sun Sep  8 12:57:52 EDT 1996
+$self->{CCFLAGS} = $Config{ccflags} . ' -DDBM_BUG_DUPLICATE_FREE' ;
diff --git a/contrib/perl5/ext/ODBM_File/typemap b/contrib/perl5/ext/ODBM_File/typemap
new file mode 100644
index 0000000..5e12e73
--- /dev/null
+++ b/contrib/perl5/ext/ODBM_File/typemap
@@ -0,0 +1,25 @@
+#
+#################################### DBM SECTION
+#
+
+datum			T_DATUM
+gdatum			T_GDATUM
+NDBM_File		T_PTROBJ
+GDBM_File		T_PTROBJ
+SDBM_File		T_PTROBJ
+ODBM_File		T_PTROBJ
+DB_File			T_PTROBJ
+DBZ_File		T_PTROBJ
+FATALFUNC		T_OPAQUEPTR
+
+INPUT
+T_DATUM
+	$var.dptr = SvPV($arg, PL_na);
+	$var.dsize = (int)PL_na;
+T_GDATUM
+	UNIMPLEMENTED
+OUTPUT
+T_DATUM
+	sv_setpvn($arg, $var.dptr, $var.dsize);
+T_GDATUM
+	sv_usepvn($arg, $var.dptr, $var.dsize);
diff --git a/contrib/perl5/ext/Opcode/Makefile.PL b/contrib/perl5/ext/Opcode/Makefile.PL
new file mode 100644
index 0000000..48a6ed8
--- /dev/null
+++ b/contrib/perl5/ext/Opcode/Makefile.PL
@@ -0,0 +1,7 @@
+use ExtUtils::MakeMaker;
+WriteMakefile(
+    NAME => 'Opcode',
+    MAN3PODS 	=> ' ',
+    VERSION_FROM => 'Opcode.pm',
+    XS_VERSION => '1.03'
+);
diff --git a/contrib/perl5/ext/Opcode/Opcode.pm b/contrib/perl5/ext/Opcode/Opcode.pm
new file mode 100644
index 0000000..0ee6be6
--- /dev/null
+++ b/contrib/perl5/ext/Opcode/Opcode.pm
@@ -0,0 +1,575 @@
+package Opcode;
+
+require 5.002;
+
+use vars qw($VERSION $XS_VERSION @ISA @EXPORT_OK);
+
+$VERSION = "1.04";
+$XS_VERSION = "1.03";
+
+use strict;
+use Carp;
+use Exporter ();
+use DynaLoader ();
+@ISA = qw(Exporter DynaLoader);
+
+BEGIN {
+    @EXPORT_OK = qw(
+	opset ops_to_opset
+	opset_to_ops opset_to_hex invert_opset
+	empty_opset full_opset
+	opdesc opcodes opmask define_optag
+	opmask_add verify_opset opdump
+    );
+}
+
+sub opset (;@);
+sub opset_to_hex ($);
+sub opdump (;$);
+use subs @EXPORT_OK;
+
+bootstrap Opcode $XS_VERSION;
+
+_init_optags();
+
+sub ops_to_opset { opset @_ }	# alias for old name
+
+sub opset_to_hex ($) {
+    return "(invalid opset)" unless verify_opset($_[0]);
+    unpack("h*",$_[0]);
+}
+
+sub opdump (;$) {
+	my $pat = shift;
+    # handy utility: perl -MOpcode=opdump -e 'opdump File'
+    foreach(opset_to_ops(full_opset)) {
+        my $op = sprintf "  %12s  %s\n", $_, opdesc($_);
+		next if defined $pat and $op !~ m/$pat/i;
+		print $op;
+    }
+}
+
+
+
+sub _init_optags {
+    my(%all, %seen);
+    @all{opset_to_ops(full_opset)} = (); # keys only
+
+    local($_);
+    local($/) = "\n=cut"; # skip to optags definition section
+    <DATA>;
+    $/ = "\n=";		# now read in 'pod section' chunks
+    while(<DATA>) {
+	next unless m/^item\s+(:\w+)/;
+	my $tag = $1;
+
+	# Split into lines, keep only indented lines
+	my @lines = grep { m/^\s/    } split(/\n/);
+	foreach (@lines) { s/--.*//  } # delete comments
+	my @ops   = map  { split ' ' } @lines; # get op words
+
+	foreach(@ops) {
+	    warn "$tag - $_ already tagged in $seen{$_}\n" if $seen{$_};
+	    $seen{$_} = $tag;
+	    delete $all{$_};
+	}
+	# opset will croak on invalid names
+	define_optag($tag, opset(@ops));
+    }
+    close(DATA);
+    warn "Untagged opnames: ".join(' ',keys %all)."\n" if %all;
+}
+
+
+1;
+
+__DATA__
+
+=head1 NAME
+
+Opcode - Disable named opcodes when compiling perl code
+
+=head1 SYNOPSIS
+
+  use Opcode;
+
+
+=head1 DESCRIPTION
+
+Perl code is always compiled into an internal format before execution.
+
+Evaluating perl code (e.g. via "eval" or "do 'file'") causes
+the code to be compiled into an internal format and then,
+provided there was no error in the compilation, executed.
+The internal format is based on many distinct I<opcodes>.
+
+By default no opmask is in effect and any code can be compiled.
+
+The Opcode module allow you to define an I<operator mask> to be in
+effect when perl I<next> compiles any code.  Attempting to compile code
+which contains a masked opcode will cause the compilation to fail
+with an error. The code will not be executed.
+
+=head1 NOTE
+
+The Opcode module is not usually used directly. See the ops pragma and
+Safe modules for more typical uses.
+
+=head1 WARNING
+
+The authors make B<no warranty>, implied or otherwise, about the
+suitability of this software for safety or security purposes.
+
+The authors shall not in any case be liable for special, incidental,
+consequential, indirect or other similar damages arising from the use
+of this software.
+
+Your mileage will vary. If in any doubt B<do not use it>.
+
+
+=head1 Operator Names and Operator Lists
+
+The canonical list of operator names is the contents of the array
+op_name defined and initialised in file F<opcode.h> of the Perl
+source distribution (and installed into the perl library).
+
+Each operator has both a terse name (its opname) and a more verbose or
+recognisable descriptive name. The opdesc function can be used to
+return a list of descriptions for a list of operators.
+
+Many of the functions and methods listed below take a list of
+operators as parameters. Most operator lists can be made up of several
+types of element. Each element can be one of
+
+=over 8
+
+=item an operator name (opname)
+
+Operator names are typically small lowercase words like enterloop,
+leaveloop, last, next, redo etc. Sometimes they are rather cryptic
+like gv2cv, i_ncmp and ftsvtx.
+
+=item an operator tag name (optag)
+
+Operator tags can be used to refer to groups (or sets) of operators.
+Tag names always begin with a colon. The Opcode module defines several
+optags and the user can define others using the define_optag function.
+
+=item a negated opname or optag
+
+An opname or optag can be prefixed with an exclamation mark, e.g., !mkdir.
+Negating an opname or optag means remove the corresponding ops from the
+accumulated set of ops at that point.
+
+=item an operator set (opset)
+
+An I<opset> as a binary string of approximately 43 bytes which holds a
+set or zero or more operators.
+
+The opset and opset_to_ops functions can be used to convert from
+a list of operators to an opset and I<vice versa>.
+
+Wherever a list of operators can be given you can use one or more opsets.
+See also Manipulating Opsets below.
+
+=back
+
+
+=head1 Opcode Functions
+
+The Opcode package contains functions for manipulating operator names
+tags and sets. All are available for export by the package.
+
+=over 8
+
+=item opcodes
+
+In a scalar context opcodes returns the number of opcodes in this
+version of perl (around 340 for perl5.002).
+
+In a list context it returns a list of all the operator names.
+(Not yet implemented, use @names = opset_to_ops(full_opset).)
+
+=item opset (OP, ...)
+
+Returns an opset containing the listed operators.
+
+=item opset_to_ops (OPSET)
+
+Returns a list of operator names corresponding to those operators in
+the set.
+
+=item opset_to_hex (OPSET)
+
+Returns a string representation of an opset. Can be handy for debugging.
+
+=item full_opset
+
+Returns an opset which includes all operators.
+
+=item empty_opset
+
+Returns an opset which contains no operators.
+
+=item invert_opset (OPSET)
+
+Returns an opset which is the inverse set of the one supplied.
+
+=item verify_opset (OPSET, ...)
+
+Returns true if the supplied opset looks like a valid opset (is the
+right length etc) otherwise it returns false. If an optional second
+parameter is true then verify_opset will croak on an invalid opset
+instead of returning false.
+
+Most of the other Opcode functions call verify_opset automatically
+and will croak if given an invalid opset.
+
+=item define_optag (OPTAG, OPSET)
+
+Define OPTAG as a symbolic name for OPSET. Optag names always start
+with a colon C<:>.
+
+The optag name used must not be defined already (define_optag will
+croak if it is already defined). Optag names are global to the perl
+process and optag definitions cannot be altered or deleted once
+defined.
+
+It is strongly recommended that applications using Opcode should use a
+leading capital letter on their tag names since lowercase names are
+reserved for use by the Opcode module. If using Opcode within a module
+you should prefix your tags names with the name of your module to
+ensure uniqueness and thus avoid clashes with other modules.
+
+=item opmask_add (OPSET)
+
+Adds the supplied opset to the current opmask. Note that there is
+currently I<no> mechanism for unmasking ops once they have been masked.
+This is intentional.
+
+=item opmask
+
+Returns an opset corresponding to the current opmask.
+
+=item opdesc (OP, ...)
+
+This takes a list of operator names and returns the corresponding list
+of operator descriptions.
+
+=item opdump (PAT)
+
+Dumps to STDOUT a two column list of op names and op descriptions.
+If an optional pattern is given then only lines which match the
+(case insensitive) pattern will be output.
+
+It's designed to be used as a handy command line utility:
+
+	perl -MOpcode=opdump -e opdump
+	perl -MOpcode=opdump -e 'opdump Eval'
+
+=back
+
+=head1 Manipulating Opsets
+
+Opsets may be manipulated using the perl bit vector operators & (and), | (or),
+^ (xor) and ~ (negate/invert).
+
+However you should never rely on the numerical position of any opcode
+within the opset. In other words both sides of a bit vector operator
+should be opsets returned from Opcode functions.
+
+Also, since the number of opcodes in your current version of perl might
+not be an exact multiple of eight, there may be unused bits in the last
+byte of an upset. This should not cause any problems (Opcode functions
+ignore those extra bits) but it does mean that using the ~ operator
+will typically not produce the same 'physical' opset 'string' as the
+invert_opset function.
+
+
+=head1 TO DO (maybe)
+
+    $bool = opset_eq($opset1, $opset2)	true if opsets are logically eqiv
+
+    $yes = opset_can($opset, @ops)	true if $opset has all @ops set
+
+    @diff = opset_diff($opset1, $opset2) => ('foo', '!bar', ...)
+
+=cut
+
+# the =cut above is used by _init_optags() to get here quickly
+
+=head1 Predefined Opcode Tags
+
+=over 5
+
+=item :base_core
+
+    null stub scalar pushmark wantarray const defined undef
+
+    rv2sv sassign
+
+    rv2av aassign aelem aelemfast aslice av2arylen
+
+    rv2hv helem hslice each values keys exists delete
+
+    preinc i_preinc predec i_predec postinc i_postinc postdec i_postdec
+    int hex oct abs pow multiply i_multiply divide i_divide
+    modulo i_modulo add i_add subtract i_subtract
+
+    left_shift right_shift bit_and bit_xor bit_or negate i_negate
+    not complement
+
+    lt i_lt gt i_gt le i_le ge i_ge eq i_eq ne i_ne ncmp i_ncmp
+    slt sgt sle sge seq sne scmp
+
+    substr vec stringify study pos length index rindex ord chr
+
+    ucfirst lcfirst uc lc quotemeta trans chop schop chomp schomp
+
+    match split qr
+
+    list lslice splice push pop shift unshift reverse
+
+    cond_expr flip flop andassign orassign and or xor
+
+    warn die lineseq nextstate unstack scope enter leave
+
+    rv2cv anoncode prototype
+
+    entersub leavesub return method -- XXX loops via recursion?
+
+    leaveeval -- needed for Safe to operate, is safe without entereval
+
+=item :base_mem
+
+These memory related ops are not included in :base_core because they
+can easily be used to implement a resource attack (e.g., consume all
+available memory).
+
+    concat repeat join range
+
+    anonlist anonhash
+
+Note that despite the existance of this optag a memory resource attack
+may still be possible using only :base_core ops.
+
+Disabling these ops is a I<very> heavy handed way to attempt to prevent
+a memory resource attack. It's probable that a specific memory limit
+mechanism will be added to perl in the near future.
+
+=item :base_loop
+
+These loop ops are not included in :base_core because they can easily be
+used to implement a resource attack (e.g., consume all available CPU time).
+
+    grepstart grepwhile
+    mapstart mapwhile
+    enteriter iter
+    enterloop leaveloop
+    last next redo
+    goto
+
+=item :base_io
+
+These ops enable I<filehandle> (rather than filename) based input and
+output. These are safe on the assumption that only pre-existing
+filehandles are available for use.  To create new filehandles other ops
+such as open would need to be enabled.
+
+    readline rcatline getc read
+
+    formline enterwrite leavewrite
+
+    print sysread syswrite send recv
+
+    eof tell seek sysseek
+
+    readdir telldir seekdir rewinddir
+
+=item :base_orig
+
+These are a hotchpotch of opcodes still waiting to be considered
+
+    gvsv gv gelem
+
+    padsv padav padhv padany
+
+    rv2gv refgen srefgen ref
+
+    bless -- could be used to change ownership of objects (reblessing)
+
+    pushre regcmaybe regcreset regcomp subst substcont
+
+    sprintf prtf -- can core dump
+
+    crypt
+
+    tie untie
+
+    dbmopen dbmclose
+    sselect select
+    pipe_op sockpair
+
+    getppid getpgrp setpgrp getpriority setpriority localtime gmtime
+
+    entertry leavetry -- can be used to 'hide' fatal errors
+
+=item :base_math
+
+These ops are not included in :base_core because of the risk of them being
+used to generate floating point exceptions (which would have to be caught
+using a $SIG{FPE} handler).
+
+    atan2 sin cos exp log sqrt
+
+These ops are not included in :base_core because they have an effect
+beyond the scope of the compartment.
+
+    rand srand
+
+=item :base_thread
+
+These ops are related to multi-threading.
+
+    lock threadsv
+
+=item :default
+
+A handy tag name for a I<reasonable> default set of ops.  (The current ops
+allowed are unstable while development continues. It will change.)
+
+    :base_core :base_mem :base_loop :base_io :base_orig :base_thread
+
+If safety matters to you (and why else would you be using the Opcode module?)
+then you should not rely on the definition of this, or indeed any other, optag!
+
+
+=item :filesys_read
+
+    stat lstat readlink
+
+    ftatime ftblk ftchr ftctime ftdir fteexec fteowned fteread
+    ftewrite ftfile ftis ftlink ftmtime ftpipe ftrexec ftrowned
+    ftrread ftsgid ftsize ftsock ftsuid fttty ftzero ftrwrite ftsvtx
+
+    fttext ftbinary
+
+    fileno
+
+=item :sys_db
+
+    ghbyname ghbyaddr ghostent shostent ehostent      -- hosts
+    gnbyname gnbyaddr gnetent snetent enetent         -- networks
+    gpbyname gpbynumber gprotoent sprotoent eprotoent -- protocols
+    gsbyname gsbyport gservent sservent eservent      -- services
+
+    gpwnam gpwuid gpwent spwent epwent getlogin       -- users
+    ggrnam ggrgid ggrent sgrent egrent                -- groups
+
+=item :browse
+
+A handy tag name for a I<reasonable> default set of ops beyond the
+:default optag.  Like :default (and indeed all the other optags) its
+current definition is unstable while development continues. It will change.
+
+The :browse tag represents the next step beyond :default. It it a
+superset of the :default ops and adds :filesys_read the :sys_db.
+The intent being that scripts can access more (possibly sensitive)
+information about your system but not be able to change it.
+
+    :default :filesys_read :sys_db
+
+=item :filesys_open
+
+    sysopen open close
+    umask binmode
+
+    open_dir closedir -- other dir ops are in :base_io
+
+=item :filesys_write
+
+    link unlink rename symlink truncate
+
+    mkdir rmdir
+
+    utime chmod chown
+
+    fcntl -- not strictly filesys related, but possibly as dangerous?
+
+=item :subprocess
+
+    backtick system
+
+    fork
+
+    wait waitpid
+
+    glob -- access to Cshell via <`rm *`>
+
+=item :ownprocess
+
+    exec exit kill
+
+    time tms -- could be used for timing attacks (paranoid?)
+
+=item :others
+
+This tag holds groups of assorted specialist opcodes that don't warrant
+having optags defined for them.
+
+SystemV Interprocess Communications:
+
+    msgctl msgget msgrcv msgsnd
+
+    semctl semget semop
+
+    shmctl shmget shmread shmwrite
+
+=item :still_to_be_decided
+
+    chdir
+    flock ioctl
+
+    socket getpeername ssockopt
+    bind connect listen accept shutdown gsockopt getsockname
+
+    sleep alarm -- changes global timer state and signal handling
+    sort -- assorted problems including core dumps
+    tied -- can be used to access object implementing a tie
+    pack unpack -- can be used to create/use memory pointers
+
+    entereval -- can be used to hide code from initial compile
+    require dofile 
+
+    caller -- get info about calling environment and args
+
+    reset
+
+    dbstate -- perl -d version of nextstate(ment) opcode
+
+=item :dangerous
+
+This tag is simply a bucket for opcodes that are unlikely to be used via
+a tag name but need to be tagged for completness and documentation.
+
+    syscall dump chroot
+
+
+=back
+
+=head1 SEE ALSO
+
+ops(3) -- perl pragma interface to Opcode module.
+
+Safe(3) -- Opcode and namespace limited execution compartments
+
+=head1 AUTHORS
+
+Originally designed and implemented by Malcolm Beattie,
+mbeattie@sable.ox.ac.uk as part of Safe version 1.
+
+Split out from Safe module version 1, named opcode tags and other
+changes added by Tim Bunce.
+
+=cut
+
diff --git a/contrib/perl5/ext/Opcode/Opcode.xs b/contrib/perl5/ext/Opcode/Opcode.xs
new file mode 100644
index 0000000..e853cf1
--- /dev/null
+++ b/contrib/perl5/ext/Opcode/Opcode.xs
@@ -0,0 +1,468 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+/* PL_maxo shouldn't differ from MAXO but leave room anyway (see BOOT:)	*/
+#define OP_MASK_BUF_SIZE (MAXO + 100)
+
+/* XXX op_named_bits and opset_all are never freed */
+static HV *op_named_bits;	/* cache shared for whole process	*/
+static SV *opset_all;		/* mask with all bits set		*/
+static IV  opset_len;		/* length of opmasks in bytes		*/
+static int opcode_debug = 0;
+
+static SV  *new_opset _((SV *old_opset));
+static int  verify_opset _((SV *opset, int fatal));
+static void set_opset_bits _((char *bitmap, SV *bitspec, int on, char *opname));
+static void put_op_bitspec _((char *optag,  STRLEN len, SV *opset));
+static SV  *get_op_bitspec _((char *opname, STRLEN len, int fatal));
+
+
+/* Initialise our private op_named_bits HV.
+ * It is first loaded with the name and number of each perl operator.
+ * Then the builtin tags :none and :all are added.
+ * Opcode.pm loads the standard optags from __DATA__
+ * XXX leak-alert: data allocated here is never freed, call this
+ *     at most once
+ */
+
+static void
+op_names_init(void)
+{
+    int i;
+    STRLEN len;
+    char **op_names;
+    char *bitmap;
+
+    op_named_bits = newHV();
+    op_names = get_op_names();
+    for(i=0; i < PL_maxo; ++i) {
+	SV *sv;
+	sv = newSViv(i);
+	SvREADONLY_on(sv);
+	hv_store(op_named_bits, op_names[i], strlen(op_names[i]), sv, 0);
+    }
+
+    put_op_bitspec(":none",0, sv_2mortal(new_opset(Nullsv)));
+
+    opset_all = new_opset(Nullsv);
+    bitmap = SvPV(opset_all, len);
+    i = len-1; /* deal with last byte specially, see below */
+    while(i-- > 0)
+	bitmap[i] = 0xFF;
+    /* Take care to set the right number of bits in the last byte */
+    bitmap[len-1] = (PL_maxo & 0x07) ? ~(0xFF << (PL_maxo & 0x07)) : 0xFF;
+    put_op_bitspec(":all",0, opset_all); /* don't mortalise */
+}
+
+
+/* Store a new tag definition. Always a mask.
+ * The tag must not already be defined.
+ * SV *mask is copied not referenced.
+ */
+
+static void
+put_op_bitspec(char *optag, STRLEN len, SV *mask)
+{
+    SV **svp;
+    verify_opset(mask,1);
+    if (!len)
+	len = strlen(optag);
+    svp = hv_fetch(op_named_bits, optag, len, 1);
+    if (SvOK(*svp))
+	croak("Opcode tag \"%s\" already defined", optag);
+    sv_setsv(*svp, mask);
+    SvREADONLY_on(*svp);
+}
+
+
+
+/* Fetch a 'bits' entry for an opname or optag (IV/PV).
+ * Note that we return the actual entry for speed.
+ * Always sv_mortalcopy() if returing it to user code.
+ */
+
+static SV *
+get_op_bitspec(char *opname, STRLEN len, int fatal)
+{
+    SV **svp;
+    if (!len)
+	len = strlen(opname);
+    svp = hv_fetch(op_named_bits, opname, len, 0);
+    if (!svp || !SvOK(*svp)) {
+	if (!fatal)
+	    return Nullsv;
+	if (*opname == ':')
+	    croak("Unknown operator tag \"%s\"", opname);
+	if (*opname == '!')	/* XXX here later, or elsewhere? */
+	    croak("Can't negate operators here (\"%s\")", opname);
+	if (isALPHA(*opname))
+	    croak("Unknown operator name \"%s\"", opname);
+	croak("Unknown operator prefix \"%s\"", opname);
+    }
+    return *svp;
+}
+
+
+
+static SV *
+new_opset(SV *old_opset)
+{
+    SV *opset;
+    if (old_opset) {
+	verify_opset(old_opset,1);
+	opset = newSVsv(old_opset);
+    }
+    else {
+	opset = NEWSV(1156, opset_len);
+	Zero(SvPVX(opset), opset_len + 1, char);
+	SvCUR_set(opset, opset_len);
+	(void)SvPOK_only(opset);
+    }
+    /* not mortalised here */
+    return opset;
+}
+
+
+static int
+verify_opset(SV *opset, int fatal)
+{
+    char *err = Nullch;
+    if      (!SvOK(opset))              err = "undefined";
+    else if (!SvPOK(opset))             err = "wrong type";
+    else if (SvCUR(opset) != opset_len) err = "wrong size";
+    if (err && fatal) {
+	croak("Invalid opset: %s", err);
+    }
+    return !err;
+}
+
+
+static void
+set_opset_bits(char *bitmap, SV *bitspec, int on, char *opname)
+{
+    if (SvIOK(bitspec)) {
+	int myopcode = SvIV(bitspec);
+	int offset = myopcode >> 3;
+	int bit    = myopcode & 0x07;
+	if (myopcode >= PL_maxo || myopcode < 0)
+	    croak("panic: opcode \"%s\" value %d is invalid", opname, myopcode);
+	if (opcode_debug >= 2)
+	    warn("set_opset_bits bit %2d (off=%d, bit=%d) %s %s\n",
+			myopcode, offset, bit, opname, (on)?"on":"off");
+	if (on)
+	    bitmap[offset] |= 1 << bit;
+	else
+	    bitmap[offset] &= ~(1 << bit);
+    }
+    else if (SvPOK(bitspec) && SvCUR(bitspec) == opset_len) {
+
+	STRLEN len;
+	char *specbits = SvPV(bitspec, len);
+	if (opcode_debug >= 2)
+	    warn("set_opset_bits opset %s %s\n", opname, (on)?"on":"off");
+	if (on) 
+	    while(len-- > 0) bitmap[len] |=  specbits[len];
+	else
+	    while(len-- > 0) bitmap[len] &= ~specbits[len];
+    }
+    else
+	croak("panic: invalid bitspec for \"%s\" (type %u)",
+		opname, (unsigned)SvTYPE(bitspec));
+}
+
+
+static void
+opmask_add(SV *opset)	/* THE ONLY FUNCTION TO EDIT PL_op_mask ITSELF	*/
+{
+    int i,j;
+    char *bitmask;
+    STRLEN len;
+    int myopcode = 0;
+
+    verify_opset(opset,1);			/* croaks on bad opset	*/
+
+    if (!PL_op_mask)		/* caller must ensure PL_op_mask exists	*/
+	croak("Can't add to uninitialised PL_op_mask");
+
+    /* OPCODES ALREADY MASKED ARE NEVER UNMASKED. See opmask_addlocal()	*/
+
+    bitmask = SvPV(opset, len);
+    for (i=0; i < opset_len; i++) {
+	U16 bits = bitmask[i];
+	if (!bits) {	/* optimise for sparse masks */
+	    myopcode += 8;
+	    continue;
+	}
+	for (j=0; j < 8 && myopcode < PL_maxo; )
+	    PL_op_mask[myopcode++] |= bits & (1 << j++);
+    }
+}
+
+static void
+opmask_addlocal(SV *opset, char *op_mask_buf) /* Localise PL_op_mask then opmask_add() */
+{
+    char *orig_op_mask = PL_op_mask;
+    SAVEPPTR(PL_op_mask);
+#if !defined(PERL_OBJECT)
+    /* XXX casting to an ordinary function ptr from a member function ptr
+     * is disallowed by Borland
+     */
+    if (opcode_debug >= 2)
+	SAVEDESTRUCTOR((void(CPERLscope(*))_((void*)))warn,"PL_op_mask restored");
+#endif
+    PL_op_mask = &op_mask_buf[0];
+    if (orig_op_mask)
+	Copy(orig_op_mask, PL_op_mask, PL_maxo, char);
+    else
+	Zero(PL_op_mask, PL_maxo, char);
+    opmask_add(opset);
+}
+
+
+
+MODULE = Opcode	PACKAGE = Opcode
+
+PROTOTYPES: ENABLE
+
+BOOT:
+    assert(PL_maxo < OP_MASK_BUF_SIZE);
+    opset_len = (PL_maxo + 7) / 8;
+    if (opcode_debug >= 1)
+	warn("opset_len %ld\n", (long)opset_len);
+    op_names_init();
+
+
+void
+_safe_call_sv(Package, mask, codesv)
+    char *	Package
+    SV *	mask
+    SV *	codesv
+PPCODE:
+    char op_mask_buf[OP_MASK_BUF_SIZE];
+    GV *gv;
+
+    ENTER;
+
+    opmask_addlocal(mask, op_mask_buf);
+
+    save_aptr(&PL_endav);
+    PL_endav = (AV*)sv_2mortal((SV*)newAV()); /* ignore END blocks for now	*/
+
+    save_hptr(&PL_defstash);		/* save current default stack	*/
+    /* the assignment to global defstash changes our sense of 'main'	*/
+    PL_defstash = gv_stashpv(Package, GV_ADDWARN); /* should exist already	*/
+
+    /* defstash must itself contain a main:: so we'll add that now	*/
+    /* take care with the ref counts (was cause of long standing bug)	*/
+    /* XXX I'm still not sure if this is right, GV_ADDWARN should warn!	*/
+    gv = gv_fetchpv("main::", GV_ADDWARN, SVt_PVHV);
+    sv_free((SV*)GvHV(gv));
+    GvHV(gv) = (HV*)SvREFCNT_inc(PL_defstash);
+
+    PUSHMARK(SP);
+    perl_call_sv(codesv, GIMME|G_EVAL|G_KEEPERR); /* use callers context */
+    SPAGAIN; /* for the PUTBACK added by xsubpp */
+    LEAVE;
+
+
+int
+verify_opset(opset, fatal = 0)
+    SV *opset
+    int fatal
+
+
+void
+invert_opset(opset)
+    SV *opset
+CODE:
+    {
+    char *bitmap;
+    STRLEN len = opset_len;
+    opset = sv_2mortal(new_opset(opset));	/* verify and clone opset */
+    bitmap = SvPVX(opset);
+    while(len-- > 0)
+	bitmap[len] = ~bitmap[len];
+    /* take care of extra bits beyond PL_maxo in last byte	*/
+    if (PL_maxo & 07)
+	bitmap[opset_len-1] &= ~(0xFF << (PL_maxo & 0x07));
+    }
+    ST(0) = opset;
+
+
+void
+opset_to_ops(opset, desc = 0)
+    SV *opset
+    int	desc
+PPCODE:
+    {
+    STRLEN len;
+    int i, j, myopcode;
+    char *bitmap = SvPV(opset, len);
+    char **names = (desc) ? get_op_descs() : get_op_names();
+    verify_opset(opset,1);
+    for (myopcode=0, i=0; i < opset_len; i++) {
+	U16 bits = bitmap[i];
+	for (j=0; j < 8 && myopcode < PL_maxo; j++, myopcode++) {
+	    if ( bits & (1 << j) )
+		XPUSHs(sv_2mortal(newSVpv(names[myopcode], 0)));
+	}
+    }
+    }
+
+
+void
+opset(...)
+CODE:
+    int i, j;
+    SV *bitspec, *opset;
+    char *bitmap;
+    STRLEN len, on;
+    opset = sv_2mortal(new_opset(Nullsv));
+    bitmap = SvPVX(opset);
+    for (i = 0; i < items; i++) {
+	char *opname;
+	on = 1;
+	if (verify_opset(ST(i),0)) {
+	    opname = "(opset)";
+	    bitspec = ST(i);
+	}
+	else {
+	    opname = SvPV(ST(i), len);
+	    if (*opname == '!') { on=0; ++opname;--len; }
+	    bitspec = get_op_bitspec(opname, len, 1);
+	}
+	set_opset_bits(bitmap, bitspec, on, opname);
+    }
+    ST(0) = opset;
+
+
+#define PERMITING  (ix == 0 || ix == 1)
+#define ONLY_THESE (ix == 0 || ix == 2)
+
+void
+permit_only(safe, ...)
+    SV *safe
+ALIAS:
+	permit    = 1
+	deny_only = 2
+	deny      = 3
+CODE:
+    int i, on;
+    SV *bitspec, *mask;
+    char *bitmap, *opname;
+    STRLEN len;
+
+    if (!SvROK(safe) || !SvOBJECT(SvRV(safe)) || SvTYPE(SvRV(safe))!=SVt_PVHV)
+	croak("Not a Safe object");
+    mask = *hv_fetch((HV*)SvRV(safe), "Mask",4, 1);
+    if (ONLY_THESE)	/* *_only = new mask, else edit current	*/
+	sv_setsv(mask, sv_2mortal(new_opset(PERMITING ? opset_all : Nullsv)));
+    else
+	verify_opset(mask,1); /* croaks */
+    bitmap = SvPVX(mask);
+    for (i = 1; i < items; i++) {
+	on = PERMITING ? 0 : 1;		/* deny = mask bit on	*/
+	if (verify_opset(ST(i),0)) {	/* it's a valid mask	*/
+	    opname = "(opset)";
+	    bitspec = ST(i);
+	}
+	else {				/* it's an opname/optag	*/
+	    opname = SvPV(ST(i), len);
+	    /* invert if op has ! prefix (only one allowed)	*/
+	    if (*opname == '!') { on = !on; ++opname; --len; }
+	    bitspec = get_op_bitspec(opname, len, 1); /* croaks */
+	}
+	set_opset_bits(bitmap, bitspec, on, opname);
+    }
+    ST(0) = &PL_sv_yes;
+
+
+
+void
+opdesc(...)
+PPCODE:
+    int i, myopcode;
+    STRLEN len;
+    SV **args;
+    char **op_desc = get_op_descs(); 
+    /* copy args to a scratch area since we may push output values onto	*/
+    /* the stack faster than we read values off it if masks are used.	*/
+    args = (SV**)SvPVX(sv_2mortal(newSVpv((char*)&ST(0), items*sizeof(SV*))));
+    for (i = 0; i < items; i++) {
+	char *opname = SvPV(args[i], len);
+	SV *bitspec = get_op_bitspec(opname, len, 1);
+	if (SvIOK(bitspec)) {
+	    myopcode = SvIV(bitspec);
+	    if (myopcode < 0 || myopcode >= PL_maxo)
+		croak("panic: opcode %d (%s) out of range",myopcode,opname);
+	    XPUSHs(sv_2mortal(newSVpv(op_desc[myopcode], 0)));
+	}
+	else if (SvPOK(bitspec) && SvCUR(bitspec) == opset_len) {
+	    int b, j;
+	    char *bitmap = SvPV(bitspec,PL_na);
+	    myopcode = 0;
+	    for (b=0; b < opset_len; b++) {
+		U16 bits = bitmap[b];
+		for (j=0; j < 8 && myopcode < PL_maxo; j++, myopcode++)
+		    if (bits & (1 << j))
+			XPUSHs(sv_2mortal(newSVpv(op_desc[myopcode], 0)));
+	    }
+	}
+	else
+	    croak("panic: invalid bitspec for \"%s\" (type %u)",
+		opname, (unsigned)SvTYPE(bitspec));
+    }
+
+
+void
+define_optag(optagsv, mask)
+    SV *optagsv
+    SV *mask
+CODE:
+    STRLEN len;
+    char *optag = SvPV(optagsv, len);
+    put_op_bitspec(optag, len, mask); /* croaks */
+    ST(0) = &PL_sv_yes;
+
+
+void
+empty_opset()
+CODE:
+    ST(0) = sv_2mortal(new_opset(Nullsv));
+
+void
+full_opset()
+CODE:
+    ST(0) = sv_2mortal(new_opset(opset_all));
+
+void
+opmask_add(opset)
+    SV *opset
+PREINIT:
+    if (!PL_op_mask)
+	Newz(0, PL_op_mask, PL_maxo, char);
+
+void
+opcodes()
+PPCODE:
+    if (GIMME == G_ARRAY) {
+	croak("opcodes in list context not yet implemented"); /* XXX */
+    }
+    else {
+	XPUSHs(sv_2mortal(newSViv(PL_maxo)));
+    }
+
+void
+opmask()
+CODE:
+    ST(0) = sv_2mortal(new_opset(Nullsv));
+    if (PL_op_mask) {
+	char *bitmap = SvPVX(ST(0));
+	int myopcode;
+	for(myopcode=0; myopcode < PL_maxo; ++myopcode) {
+	    if (PL_op_mask[myopcode])
+		bitmap[myopcode >> 3] |= 1 << (myopcode & 0x07);
+	}
+    }
+
diff --git a/contrib/perl5/ext/Opcode/Safe.pm b/contrib/perl5/ext/Opcode/Safe.pm
new file mode 100644
index 0000000..940a972
--- /dev/null
+++ b/contrib/perl5/ext/Opcode/Safe.pm
@@ -0,0 +1,559 @@
+package Safe;
+
+use 5.003_11;
+use strict;
+use vars qw($VERSION);
+
+$VERSION = "2.06";
+
+use Carp;
+
+use Opcode 1.01, qw(
+    opset opset_to_ops opmask_add
+    empty_opset full_opset invert_opset verify_opset
+    opdesc opcodes opmask define_optag opset_to_hex
+);
+
+*ops_to_opset = \&opset;   # Temporary alias for old Penguins
+
+
+my $default_root  = 0;
+my $default_share = ['*_']; #, '*main::'];
+
+sub new {
+    my($class, $root, $mask) = @_;
+    my $obj = {};
+    bless $obj, $class;
+
+    if (defined($root)) {
+	croak "Can't use \"$root\" as root name"
+	    if $root =~ /^main\b/ or $root !~ /^\w[:\w]*$/;
+	$obj->{Root}  = $root;
+	$obj->{Erase} = 0;
+    }
+    else {
+	$obj->{Root}  = "Safe::Root".$default_root++;
+	$obj->{Erase} = 1;
+    }
+
+    # use permit/deny methods instead till interface issues resolved
+    # XXX perhaps new Safe 'Root', mask => $mask, foo => bar, ...;
+    croak "Mask parameter to new no longer supported" if defined $mask;
+    $obj->permit_only(':default');
+
+    # We must share $_ and @_ with the compartment or else ops such
+    # as split, length and so on won't default to $_ properly, nor
+    # will passing argument to subroutines work (via @_). In fact,
+    # for reasons I don't completely understand, we need to share
+    # the whole glob *_ rather than $_ and @_ separately, otherwise
+    # @_ in non default packages within the compartment don't work.
+    $obj->share_from('main', $default_share);
+    return $obj;
+}
+
+sub DESTROY {
+    my $obj = shift;
+    $obj->erase('DESTROY') if $obj->{Erase};
+}
+
+sub erase {
+    my ($obj, $action) = @_;
+    my $pkg = $obj->root();
+    my ($stem, $leaf);
+
+    no strict 'refs';
+    $pkg = "main::$pkg\::";	# expand to full symbol table name
+    ($stem, $leaf) = $pkg =~ m/(.*::)(\w+::)$/;
+
+    # The 'my $foo' is needed! Without it you get an
+    # 'Attempt to free unreferenced scalar' warning!
+    my $stem_symtab = *{$stem}{HASH};
+
+    #warn "erase($pkg) stem=$stem, leaf=$leaf";
+    #warn " stem_symtab hash ".scalar(%$stem_symtab)."\n";
+	# ", join(', ', %$stem_symtab),"\n";
+
+#    delete $stem_symtab->{$leaf};
+
+    my $leaf_glob   = $stem_symtab->{$leaf};
+    my $leaf_symtab = *{$leaf_glob}{HASH};
+#    warn " leaf_symtab ", join(', ', %$leaf_symtab),"\n";
+    %$leaf_symtab = ();
+    #delete $leaf_symtab->{'__ANON__'};
+    #delete $leaf_symtab->{'foo'};
+    #delete $leaf_symtab->{'main::'};
+#    my $foo = undef ${"$stem\::"}{"$leaf\::"};
+
+    if ($action and $action eq 'DESTROY') {
+        delete $stem_symtab->{$leaf};
+    } else {
+        $obj->share_from('main', $default_share);
+    }
+    1;
+}
+
+
+sub reinit {
+    my $obj= shift;
+    $obj->erase;
+    $obj->share_redo;
+}
+
+sub root {
+    my $obj = shift;
+    croak("Safe root method now read-only") if @_;
+    return $obj->{Root};
+}
+
+
+sub mask {
+    my $obj = shift;
+    return $obj->{Mask} unless @_;
+    $obj->deny_only(@_);
+}
+
+# v1 compatibility methods
+sub trap   { shift->deny(@_)   }
+sub untrap { shift->permit(@_) }
+
+sub deny {
+    my $obj = shift;
+    $obj->{Mask} |= opset(@_);
+}
+sub deny_only {
+    my $obj = shift;
+    $obj->{Mask} = opset(@_);
+}
+
+sub permit {
+    my $obj = shift;
+    # XXX needs testing
+    $obj->{Mask} &= invert_opset opset(@_);
+}
+sub permit_only {
+    my $obj = shift;
+    $obj->{Mask} = invert_opset opset(@_);
+}
+
+
+sub dump_mask {
+    my $obj = shift;
+    print opset_to_hex($obj->{Mask}),"\n";
+}
+
+
+
+sub share {
+    my($obj, @vars) = @_;
+    $obj->share_from(scalar(caller), \@vars);
+}
+
+sub share_from {
+    my $obj = shift;
+    my $pkg = shift;
+    my $vars = shift;
+    my $no_record = shift || 0;
+    my $root = $obj->root();
+    croak("vars not an array ref") unless ref $vars eq 'ARRAY';
+	no strict 'refs';
+    # Check that 'from' package actually exists
+    croak("Package \"$pkg\" does not exist")
+	unless keys %{"$pkg\::"};
+    my $arg;
+    foreach $arg (@$vars) {
+	# catch some $safe->share($var) errors:
+	croak("'$arg' not a valid symbol table name")
+	    unless $arg =~ /^[\$\@%*&]?\w[\w:]*$/
+	    	or $arg =~ /^\$\W$/;
+	my ($var, $type);
+	$type = $1 if ($var = $arg) =~ s/^(\W)//;
+	# warn "share_from $pkg $type $var";
+	*{$root."::$var"} = (!$type)       ? \&{$pkg."::$var"}
+			  : ($type eq '&') ? \&{$pkg."::$var"}
+			  : ($type eq '$') ? \${$pkg."::$var"}
+			  : ($type eq '@') ? \@{$pkg."::$var"}
+			  : ($type eq '%') ? \%{$pkg."::$var"}
+			  : ($type eq '*') ?  *{$pkg."::$var"}
+			  : croak(qq(Can't share "$type$var" of unknown type));
+    }
+    $obj->share_record($pkg, $vars) unless $no_record or !$vars;
+}
+
+sub share_record {
+    my $obj = shift;
+    my $pkg = shift;
+    my $vars = shift;
+    my $shares = \%{$obj->{Shares} ||= {}};
+    # Record shares using keys of $obj->{Shares}. See reinit.
+    @{$shares}{@$vars} = ($pkg) x @$vars if @$vars;
+}
+sub share_redo {
+    my $obj = shift;
+    my $shares = \%{$obj->{Shares} ||= {}};
+	my($var, $pkg);
+    while(($var, $pkg) = each %$shares) {
+	# warn "share_redo $pkg\:: $var";
+	$obj->share_from($pkg,  [ $var ], 1);
+    }
+}
+sub share_forget {
+    delete shift->{Shares};
+}
+
+sub varglob {
+    my ($obj, $var) = @_;
+    no strict 'refs';
+    return *{$obj->root()."::$var"};
+}
+
+
+sub reval {
+    my ($obj, $expr, $strict) = @_;
+    my $root = $obj->{Root};
+
+    # Create anon sub ref in root of compartment.
+    # Uses a closure (on $expr) to pass in the code to be executed.
+    # (eval on one line to keep line numbers as expected by caller)
+	my $evalcode = sprintf('package %s; sub { eval $expr; }', $root);
+    my $evalsub;
+
+	if ($strict) { use strict; $evalsub = eval $evalcode; }
+	else         {  no strict; $evalsub = eval $evalcode; }
+
+    return Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub);
+}
+
+sub rdo {
+    my ($obj, $file) = @_;
+    my $root = $obj->{Root};
+
+    my $evalsub = eval
+	    sprintf('package %s; sub { do $file }', $root);
+    return Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub);
+}
+
+
+1;
+
+__DATA__
+
+=head1 NAME
+
+Safe - Compile and execute code in restricted compartments
+
+=head1 SYNOPSIS
+
+  use Safe;
+
+  $compartment = new Safe;
+
+  $compartment->permit(qw(time sort :browse));
+
+  $result = $compartment->reval($unsafe_code);
+
+=head1 DESCRIPTION
+
+The Safe extension module allows the creation of compartments
+in which perl code can be evaluated. Each compartment has
+
+=over 8
+
+=item a new namespace
+
+The "root" of the namespace (i.e. "main::") is changed to a
+different package and code evaluated in the compartment cannot
+refer to variables outside this namespace, even with run-time
+glob lookups and other tricks.
+
+Code which is compiled outside the compartment can choose to place
+variables into (or I<share> variables with) the compartment's namespace
+and only that data will be visible to code evaluated in the
+compartment.
+
+By default, the only variables shared with compartments are the
+"underscore" variables $_ and @_ (and, technically, the less frequently
+used %_, the _ filehandle and so on). This is because otherwise perl
+operators which default to $_ will not work and neither will the
+assignment of arguments to @_ on subroutine entry.
+
+=item an operator mask
+
+Each compartment has an associated "operator mask". Recall that
+perl code is compiled into an internal format before execution.
+Evaluating perl code (e.g. via "eval" or "do 'file'") causes
+the code to be compiled into an internal format and then,
+provided there was no error in the compilation, executed.
+Code evaulated in a compartment compiles subject to the
+compartment's operator mask. Attempting to evaulate code in a
+compartment which contains a masked operator will cause the
+compilation to fail with an error. The code will not be executed.
+
+The default operator mask for a newly created compartment is
+the ':default' optag.
+
+It is important that you read the Opcode(3) module documentation
+for more information, especially for detailed definitions of opnames,
+optags and opsets.
+
+Since it is only at the compilation stage that the operator mask
+applies, controlled access to potentially unsafe operations can
+be achieved by having a handle to a wrapper subroutine (written
+outside the compartment) placed into the compartment. For example,
+
+    $cpt = new Safe;
+    sub wrapper {
+        # vet arguments and perform potentially unsafe operations
+    }
+    $cpt->share('&wrapper');
+
+=back
+
+
+=head1 WARNING
+
+The authors make B<no warranty>, implied or otherwise, about the
+suitability of this software for safety or security purposes.
+
+The authors shall not in any case be liable for special, incidental,
+consequential, indirect or other similar damages arising from the use
+of this software.
+
+Your mileage will vary. If in any doubt B<do not use it>.
+
+
+=head2 RECENT CHANGES
+
+The interface to the Safe module has changed quite dramatically since
+version 1 (as supplied with Perl5.002). Study these pages carefully if
+you have code written to use Safe version 1 because you will need to
+makes changes.
+
+
+=head2 Methods in class Safe
+
+To create a new compartment, use
+
+    $cpt = new Safe;
+
+Optional argument is (NAMESPACE), where NAMESPACE is the root namespace
+to use for the compartment (defaults to "Safe::Root0", incremented for
+each new compartment).
+
+Note that version 1.00 of the Safe module supported a second optional
+parameter, MASK.  That functionality has been withdrawn pending deeper
+consideration. Use the permit and deny methods described below.
+
+The following methods can then be used on the compartment
+object returned by the above constructor. The object argument
+is implicit in each case.
+
+
+=over 8
+
+=item permit (OP, ...)
+
+Permit the listed operators to be used when compiling code in the
+compartment (in I<addition> to any operators already permitted).
+
+=item permit_only (OP, ...)
+
+Permit I<only> the listed operators to be used when compiling code in
+the compartment (I<no> other operators are permitted).
+
+=item deny (OP, ...)
+
+Deny the listed operators from being used when compiling code in the
+compartment (other operators may still be permitted).
+
+=item deny_only (OP, ...)
+
+Deny I<only> the listed operators from being used when compiling code
+in the compartment (I<all> other operators will be permitted).
+
+=item trap (OP, ...)
+
+=item untrap (OP, ...)
+
+The trap and untrap methods are synonyms for deny and permit
+respectfully.
+
+=item share (NAME, ...)
+
+This shares the variable(s) in the argument list with the compartment.
+This is almost identical to exporting variables using the L<Exporter(3)>
+module.
+
+Each NAME must be the B<name> of a variable, typically with the leading
+type identifier included. A bareword is treated as a function name.
+
+Examples of legal names are '$foo' for a scalar, '@foo' for an
+array, '%foo' for a hash, '&foo' or 'foo' for a subroutine and '*foo'
+for a glob (i.e.  all symbol table entries associated with "foo",
+including scalar, array, hash, sub and filehandle).
+
+Each NAME is assumed to be in the calling package. See share_from
+for an alternative method (which share uses).
+
+=item share_from (PACKAGE, ARRAYREF)
+
+This method is similar to share() but allows you to explicitly name the
+package that symbols should be shared from. The symbol names (including
+type characters) are supplied as an array reference.
+
+    $safe->share_from('main', [ '$foo', '%bar', 'func' ]);
+
+
+=item varglob (VARNAME)
+
+This returns a glob reference for the symbol table entry of VARNAME in
+the package of the compartment. VARNAME must be the B<name> of a
+variable without any leading type marker. For example,
+
+    $cpt = new Safe 'Root';
+    $Root::foo = "Hello world";
+    # Equivalent version which doesn't need to know $cpt's package name:
+    ${$cpt->varglob('foo')} = "Hello world";
+
+
+=item reval (STRING)
+
+This evaluates STRING as perl code inside the compartment.
+
+The code can only see the compartment's namespace (as returned by the
+B<root> method). The compartment's root package appears to be the
+C<main::> package to the code inside the compartment.
+
+Any attempt by the code in STRING to use an operator which is not permitted
+by the compartment will cause an error (at run-time of the main program
+but at compile-time for the code in STRING).  The error is of the form
+"%s trapped by operation mask operation...".
+
+If an operation is trapped in this way, then the code in STRING will
+not be executed. If such a trapped operation occurs or any other
+compile-time or return error, then $@ is set to the error message, just
+as with an eval().
+
+If there is no error, then the method returns the value of the last
+expression evaluated, or a return statement may be used, just as with
+subroutines and B<eval()>. The context (list or scalar) is determined
+by the caller as usual.
+
+This behaviour differs from the beta distribution of the Safe extension
+where earlier versions of perl made it hard to mimic the return
+behaviour of the eval() command and the context was always scalar.
+
+Some points to note:
+
+If the entereval op is permitted then the code can use eval "..." to
+'hide' code which might use denied ops. This is not a major problem
+since when the code tries to execute the eval it will fail because the
+opmask is still in effect. However this technique would allow clever,
+and possibly harmful, code to 'probe' the boundaries of what is
+possible.
+
+Any string eval which is executed by code executing in a compartment,
+or by code called from code executing in a compartment, will be eval'd
+in the namespace of the compartment. This is potentially a serious
+problem.
+
+Consider a function foo() in package pkg compiled outside a compartment
+but shared with it. Assume the compartment has a root package called
+'Root'. If foo() contains an eval statement like eval '$foo = 1' then,
+normally, $pkg::foo will be set to 1.  If foo() is called from the
+compartment (by whatever means) then instead of setting $pkg::foo, the
+eval will actually set $Root::pkg::foo.
+
+This can easily be demonstrated by using a module, such as the Socket
+module, which uses eval "..." as part of an AUTOLOAD function. You can
+'use' the module outside the compartment and share an (autoloaded)
+function with the compartment. If an autoload is triggered by code in
+the compartment, or by any code anywhere that is called by any means
+from the compartment, then the eval in the Socket module's AUTOLOAD
+function happens in the namespace of the compartment. Any variables
+created or used by the eval'd code are now under the control of
+the code in the compartment.
+
+A similar effect applies to I<all> runtime symbol lookups in code
+called from a compartment but not compiled within it.
+
+
+
+=item rdo (FILENAME)
+
+This evaluates the contents of file FILENAME inside the compartment.
+See above documentation on the B<reval> method for further details.
+
+=item root (NAMESPACE)
+
+This method returns the name of the package that is the root of the
+compartment's namespace.
+
+Note that this behaviour differs from version 1.00 of the Safe module
+where the root module could be used to change the namespace. That
+functionality has been withdrawn pending deeper consideration.
+
+=item mask (MASK)
+
+This is a get-or-set method for the compartment's operator mask.
+
+With no MASK argument present, it returns the current operator mask of
+the compartment.
+
+With the MASK argument present, it sets the operator mask for the
+compartment (equivalent to calling the deny_only method).
+
+=back
+
+
+=head2 Some Safety Issues
+
+This section is currently just an outline of some of the things code in
+a compartment might do (intentionally or unintentionally) which can
+have an effect outside the compartment.
+
+=over 8
+
+=item Memory
+
+Consuming all (or nearly all) available memory.
+
+=item CPU
+
+Causing infinite loops etc.
+
+=item Snooping
+
+Copying private information out of your system. Even something as
+simple as your user name is of value to others. Much useful information
+could be gleaned from your environment variables for example.
+
+=item Signals
+
+Causing signals (especially SIGFPE and SIGALARM) to affect your process.
+
+Setting up a signal handler will need to be carefully considered
+and controlled.  What mask is in effect when a signal handler
+gets called?  If a user can get an imported function to get an
+exception and call the user's signal handler, does that user's
+restricted mask get re-instated before the handler is called?
+Does an imported handler get called with its original mask or
+the user's one?
+
+=item State Changes
+
+Ops such as chdir obviously effect the process as a whole and not just
+the code in the compartment. Ops such as rand and srand have a similar
+but more subtle effect.
+
+=back
+
+=head2 AUTHOR
+
+Originally designed and implemented by Malcolm Beattie,
+mbeattie@sable.ox.ac.uk.
+
+Reworked to use the Opcode module and other changes added by Tim Bunce
+E<lt>F<Tim.Bunce@ig.co.uk>E<gt>.
+
+=cut
+
diff --git a/contrib/perl5/ext/Opcode/ops.pm b/contrib/perl5/ext/Opcode/ops.pm
new file mode 100644
index 0000000..b9ea36c
--- /dev/null
+++ b/contrib/perl5/ext/Opcode/ops.pm
@@ -0,0 +1,45 @@
+package ops;
+
+use Opcode qw(opmask_add opset invert_opset);
+
+sub import {
+    shift;
+    # Not that unimport is the prefered form since import's don't
+	# accumulate well owing to the 'only ever add opmask' rule.
+	# E.g., perl -Mops=:set1 -Mops=:setb is unlikely to do as expected.
+    opmask_add(invert_opset opset(@_)) if @_;
+}
+
+sub unimport {
+    shift;
+    opmask_add(opset(@_)) if @_;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+ops - Perl pragma to restrict unsafe operations when compiling
+
+=head1 SYNOPSIS  
+
+  perl -Mops=:default ...    # only allow reasonably safe operations
+
+  perl -M-ops=system ...     # disable the 'system' opcode
+
+=head1 DESCRIPTION
+
+Since the ops pragma currently has an irreversable global effect, it is
+only of significant practical use with the C<-M> option on the command line.
+
+See the L<Opcode> module for information about opcodes, optags, opmasks
+and important information about safety.
+
+=head1 SEE ALSO
+
+Opcode(3), Safe(3), perlrun(3)
+
+=cut
+
diff --git a/contrib/perl5/ext/POSIX/Makefile.PL b/contrib/perl5/ext/POSIX/Makefile.PL
new file mode 100644
index 0000000..bc1dda9
--- /dev/null
+++ b/contrib/perl5/ext/POSIX/Makefile.PL
@@ -0,0 +1,8 @@
+use ExtUtils::MakeMaker;
+WriteMakefile(
+    NAME	=> 'POSIX',
+    ($^O eq 'MSWin32' ? () : (LIBS	=> ["-lm -lposix -lcposix"])),
+    MAN3PODS 	=> ' ', 	# Pods will be built by installman.
+    XSPROTOARG => '-noprototypes', 		# XXX remove later?
+    VERSION_FROM => 'POSIX.pm', 
+);
diff --git a/contrib/perl5/ext/POSIX/POSIX.pm b/contrib/perl5/ext/POSIX/POSIX.pm
new file mode 100644
index 0000000..5d3ef5c
--- /dev/null
+++ b/contrib/perl5/ext/POSIX/POSIX.pm
@@ -0,0 +1,926 @@
+package POSIX;
+
+use vars qw($VERSION @ISA %EXPORT_TAGS @EXPORT_OK $AUTOLOAD); 
+
+use Carp;
+use AutoLoader;
+require Config;
+use Symbol;
+
+require Exporter;
+require DynaLoader;
+@ISA = qw(Exporter DynaLoader);
+
+$VERSION = "1.02" ;
+
+%EXPORT_TAGS = (
+
+    assert_h =>	[qw(assert NDEBUG)],
+
+    ctype_h =>	[qw(isalnum isalpha iscntrl isdigit isgraph islower
+		isprint ispunct isspace isupper isxdigit tolower toupper)],
+
+    dirent_h =>	[qw()],
+
+    errno_h =>	[qw(E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EAFNOSUPPORT
+		EAGAIN EALREADY EBADF EBUSY ECHILD ECONNABORTED
+		ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ EDOM EDQUOT
+		EEXIST EFAULT EFBIG EHOSTDOWN EHOSTUNREACH EINPROGRESS
+		EINTR EINVAL EIO EISCONN EISDIR ELOOP EMFILE EMLINK
+		EMSGSIZE ENAMETOOLONG ENETDOWN ENETRESET ENETUNREACH
+		ENFILE ENOBUFS ENODEV ENOENT ENOEXEC ENOLCK ENOMEM
+		ENOPROTOOPT ENOSPC ENOSYS ENOTBLK ENOTCONN ENOTDIR
+		ENOTEMPTY ENOTSOCK ENOTTY ENXIO EOPNOTSUPP EPERM
+		EPFNOSUPPORT EPIPE EPROCLIM EPROTONOSUPPORT EPROTOTYPE
+		ERANGE EREMOTE ERESTART EROFS ESHUTDOWN ESOCKTNOSUPPORT
+		ESPIPE ESRCH ESTALE ETIMEDOUT ETOOMANYREFS ETXTBSY
+		EUSERS EWOULDBLOCK EXDEV errno)],
+
+    fcntl_h =>	[qw(FD_CLOEXEC F_DUPFD F_GETFD F_GETFL F_GETLK F_RDLCK
+		F_SETFD F_SETFL F_SETLK F_SETLKW F_UNLCK F_WRLCK
+		O_ACCMODE O_APPEND O_CREAT O_EXCL O_NOCTTY O_NONBLOCK
+		O_RDONLY O_RDWR O_TRUNC O_WRONLY
+		creat
+		SEEK_CUR SEEK_END SEEK_SET
+		S_IRGRP S_IROTH S_IRUSR S_IRWXG S_IRWXO S_IRWXU
+		S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISGID S_ISREG S_ISUID
+		S_IWGRP S_IWOTH S_IWUSR)],
+
+    float_h =>	[qw(DBL_DIG DBL_EPSILON DBL_MANT_DIG
+		DBL_MAX DBL_MAX_10_EXP DBL_MAX_EXP
+		DBL_MIN DBL_MIN_10_EXP DBL_MIN_EXP
+		FLT_DIG FLT_EPSILON FLT_MANT_DIG
+		FLT_MAX FLT_MAX_10_EXP FLT_MAX_EXP
+		FLT_MIN FLT_MIN_10_EXP FLT_MIN_EXP
+		FLT_RADIX FLT_ROUNDS
+		LDBL_DIG LDBL_EPSILON LDBL_MANT_DIG
+		LDBL_MAX LDBL_MAX_10_EXP LDBL_MAX_EXP
+		LDBL_MIN LDBL_MIN_10_EXP LDBL_MIN_EXP)],
+
+    grp_h =>	[qw()],
+
+    limits_h =>	[qw( ARG_MAX CHAR_BIT CHAR_MAX CHAR_MIN CHILD_MAX
+		INT_MAX INT_MIN LINK_MAX LONG_MAX LONG_MIN MAX_CANON
+		MAX_INPUT MB_LEN_MAX NAME_MAX NGROUPS_MAX OPEN_MAX
+		PATH_MAX PIPE_BUF SCHAR_MAX SCHAR_MIN SHRT_MAX SHRT_MIN
+		SSIZE_MAX STREAM_MAX TZNAME_MAX UCHAR_MAX UINT_MAX
+		ULONG_MAX USHRT_MAX _POSIX_ARG_MAX _POSIX_CHILD_MAX
+		_POSIX_LINK_MAX _POSIX_MAX_CANON _POSIX_MAX_INPUT
+		_POSIX_NAME_MAX _POSIX_NGROUPS_MAX _POSIX_OPEN_MAX
+		_POSIX_PATH_MAX _POSIX_PIPE_BUF _POSIX_SSIZE_MAX
+		_POSIX_STREAM_MAX _POSIX_TZNAME_MAX)],
+
+    locale_h =>	[qw(LC_ALL LC_COLLATE LC_CTYPE LC_MONETARY LC_NUMERIC
+		LC_TIME NULL localeconv setlocale)],
+
+    math_h =>	[qw(HUGE_VAL acos asin atan ceil cosh fabs floor fmod
+		frexp ldexp log10 modf pow sinh tan tanh)],
+
+    pwd_h =>	[qw()],
+
+    setjmp_h =>	[qw(longjmp setjmp siglongjmp sigsetjmp)],
+
+    signal_h =>	[qw(SA_NOCLDSTOP SA_NOCLDWAIT SA_NODEFER SA_ONSTACK
+		SA_RESETHAND SA_RESTART SA_SIGINFO SIGABRT SIGALRM
+		SIGCHLD SIGCONT SIGFPE SIGHUP SIGILL SIGINT SIGKILL
+		SIGPIPE SIGQUIT SIGSEGV SIGSTOP SIGTERM SIGTSTP SIGTTIN
+		SIGTTOU SIGUSR1 SIGUSR2 SIG_BLOCK SIG_DFL SIG_ERR
+		SIG_IGN SIG_SETMASK SIG_UNBLOCK raise sigaction signal
+		sigpending sigprocmask sigsuspend)],
+
+    stdarg_h =>	[qw()],
+
+    stddef_h =>	[qw(NULL offsetof)],
+
+    stdio_h =>	[qw(BUFSIZ EOF FILENAME_MAX L_ctermid L_cuserid
+		L_tmpname NULL SEEK_CUR SEEK_END SEEK_SET
+		STREAM_MAX TMP_MAX stderr stdin stdout
+		clearerr fclose fdopen feof ferror fflush fgetc fgetpos
+		fgets fopen fprintf fputc fputs fread freopen
+		fscanf fseek fsetpos ftell fwrite getchar gets
+		perror putc putchar puts remove rewind
+		scanf setbuf setvbuf sscanf tmpfile tmpnam
+		ungetc vfprintf vprintf vsprintf)],
+
+    stdlib_h =>	[qw(EXIT_FAILURE EXIT_SUCCESS MB_CUR_MAX NULL RAND_MAX
+		abort atexit atof atoi atol bsearch calloc div
+		free getenv labs ldiv malloc mblen mbstowcs mbtowc
+		qsort realloc strtod strtol strtoul wcstombs wctomb)],
+
+    string_h =>	[qw(NULL memchr memcmp memcpy memmove memset strcat
+		strchr strcmp strcoll strcpy strcspn strerror strlen
+		strncat strncmp strncpy strpbrk strrchr strspn strstr
+		strtok strxfrm)],
+
+    sys_stat_h => [qw(S_IRGRP S_IROTH S_IRUSR S_IRWXG S_IRWXO S_IRWXU
+		S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISGID S_ISREG
+		S_ISUID S_IWGRP S_IWOTH S_IWUSR S_IXGRP S_IXOTH S_IXUSR
+		fstat mkfifo)],
+
+    sys_times_h => [qw()],
+
+    sys_types_h => [qw()],
+
+    sys_utsname_h => [qw(uname)],
+
+    sys_wait_h => [qw(WEXITSTATUS WIFEXITED WIFSIGNALED WIFSTOPPED
+		WNOHANG WSTOPSIG WTERMSIG WUNTRACED)],
+
+    termios_h => [qw( B0 B110 B1200 B134 B150 B1800 B19200 B200 B2400
+		B300 B38400 B4800 B50 B600 B75 B9600 BRKINT CLOCAL
+		CREAD CS5 CS6 CS7 CS8 CSIZE CSTOPB ECHO ECHOE ECHOK
+		ECHONL HUPCL ICANON ICRNL IEXTEN IGNBRK IGNCR IGNPAR
+		INLCR INPCK ISIG ISTRIP IXOFF IXON NCCS NOFLSH OPOST
+		PARENB PARMRK PARODD TCIFLUSH TCIOFF TCIOFLUSH TCION
+		TCOFLUSH TCOOFF TCOON TCSADRAIN TCSAFLUSH TCSANOW
+		TOSTOP VEOF VEOL VERASE VINTR VKILL VMIN VQUIT VSTART
+		VSTOP VSUSP VTIME
+		cfgetispeed cfgetospeed cfsetispeed cfsetospeed tcdrain
+		tcflow tcflush tcgetattr tcsendbreak tcsetattr )],
+
+    time_h =>	[qw(CLK_TCK CLOCKS_PER_SEC NULL asctime clock ctime
+		difftime mktime strftime tzset tzname)],
+
+    unistd_h =>	[qw(F_OK NULL R_OK SEEK_CUR SEEK_END SEEK_SET
+		STRERR_FILENO STDIN_FILENO STDOUT_FILENO W_OK X_OK
+		_PC_CHOWN_RESTRICTED _PC_LINK_MAX _PC_MAX_CANON
+		_PC_MAX_INPUT _PC_NAME_MAX _PC_NO_TRUNC _PC_PATH_MAX
+		_PC_PIPE_BUF _PC_VDISABLE _POSIX_CHOWN_RESTRICTED
+		_POSIX_JOB_CONTROL _POSIX_NO_TRUNC _POSIX_SAVED_IDS
+		_POSIX_VDISABLE _POSIX_VERSION _SC_ARG_MAX
+		_SC_CHILD_MAX _SC_CLK_TCK _SC_JOB_CONTROL
+		_SC_NGROUPS_MAX _SC_OPEN_MAX _SC_SAVED_IDS
+		_SC_STREAM_MAX _SC_TZNAME_MAX _SC_VERSION
+		_exit access ctermid cuserid
+		dup2 dup execl execle execlp execv execve execvp
+		fpathconf getcwd getegid geteuid getgid getgroups
+		getpid getuid isatty lseek pathconf pause setgid setpgid
+		setsid setuid sysconf tcgetpgrp tcsetpgrp ttyname)],
+
+    utime_h =>	[qw()],
+
+);
+
+Exporter::export_tags();
+
+@EXPORT_OK = qw(
+    closedir opendir readdir rewinddir
+    fcntl open
+    getgrgid getgrnam
+    atan2 cos exp log sin sqrt
+    getpwnam getpwuid
+    kill
+    fileno getc printf rename sprintf
+    abs exit rand srand system
+    chmod mkdir stat umask
+    times
+    wait waitpid
+    gmtime localtime time 
+    alarm chdir chown close fork getlogin getppid getpgrp link
+	pipe read rmdir sleep unlink write
+    utime
+    nice
+);
+
+# Grandfather old foo_h form to new :foo_h form
+sub import {
+    my $this = shift;
+    my @list = map { m/^\w+_h$/ ? ":$_" : $_ } @_;
+    local $Exporter::ExportLevel = 1;
+    Exporter::import($this,@list);
+}
+
+
+bootstrap POSIX $VERSION;
+
+my $EINVAL = constant("EINVAL", 0);
+my $EAGAIN = constant("EAGAIN", 0);
+
+sub AUTOLOAD {
+    if ($AUTOLOAD =~ /::(_?[a-z])/) {
+	$AutoLoader::AUTOLOAD = $AUTOLOAD;
+	goto &AutoLoader::AUTOLOAD
+    }
+    local $! = 0;
+    my $constname = $AUTOLOAD;
+    $constname =~ s/.*:://;
+    my $val = constant($constname, @_ ? $_[0] : 0);
+    if ($! == 0) {
+	*$AUTOLOAD = sub { $val };
+    }
+    elsif ($! == $EAGAIN) {	# Not really a constant, so always call.
+	*$AUTOLOAD = sub { constant($constname, $_[0]) };
+    }
+    elsif ($! == $EINVAL) {
+	croak "$constname is not a valid POSIX macro";
+    }
+    else {
+	croak "Your vendor has not defined POSIX macro $constname, used";
+    }
+
+    goto &$AUTOLOAD;
+}
+
+sub usage { 
+    my ($mess) = @_;
+    croak "Usage: POSIX::$mess";
+}
+
+sub redef { 
+    my ($mess) = @_;
+    croak "Use method $mess instead";
+}
+
+sub unimpl { 
+    my ($mess) = @_;
+    $mess =~ s/xxx//;
+    croak "Unimplemented: POSIX::$mess";
+}
+
+############################
+package POSIX::SigAction;
+
+sub new {
+    bless {HANDLER => $_[1], MASK => $_[2], FLAGS => $_[3] || 0}, $_[0];
+}
+
+############################
+package POSIX; # return to package POSIX so AutoSplit is happy
+1;
+__END__
+
+sub assert {
+    usage "assert(expr)" if @_ != 1;
+    if (!$_[0]) {
+	croak "Assertion failed";
+    }
+}
+
+sub tolower {
+    usage "tolower(string)" if @_ != 1;
+    lc($_[0]);
+}
+
+sub toupper {
+    usage "toupper(string)" if @_ != 1;
+    uc($_[0]);
+}
+
+sub closedir {
+    usage "closedir(dirhandle)" if @_ != 1;
+    closedir($_[0]);
+}
+
+sub opendir {
+    usage "opendir(directory)" if @_ != 1;
+    my $dirhandle = gensym;
+    opendir($dirhandle, $_[0])
+	? $dirhandle
+	: undef;
+}
+
+sub readdir {
+    usage "readdir(dirhandle)" if @_ != 1;
+    readdir($_[0]);
+}
+
+sub rewinddir {
+    usage "rewinddir(dirhandle)" if @_ != 1;
+    rewinddir($_[0]);
+}
+
+sub errno {
+    usage "errno()" if @_ != 0;
+    $! + 0;
+}
+
+sub creat {
+    usage "creat(filename, mode)" if @_ != 2;
+    &open($_[0], &O_WRONLY | &O_CREAT | &O_TRUNC, $_[1]);
+}
+
+sub fcntl {
+    usage "fcntl(filehandle, cmd, arg)" if @_ != 3;
+    fcntl($_[0], $_[1], $_[2]);
+}
+
+sub getgrgid {
+    usage "getgrgid(gid)" if @_ != 1;
+    getgrgid($_[0]);
+}
+
+sub getgrnam {
+    usage "getgrnam(name)" if @_ != 1;
+    getgrnam($_[0]);
+}
+
+sub atan2 {
+    usage "atan2(x,y)" if @_ != 2;
+    atan2($_[0], $_[1]);
+}
+
+sub cos {
+    usage "cos(x)" if @_ != 1;
+    cos($_[0]);
+}
+
+sub exp {
+    usage "exp(x)" if @_ != 1;
+    exp($_[0]);
+}
+
+sub fabs {
+    usage "fabs(x)" if @_ != 1;
+    abs($_[0]);
+}
+
+sub log {
+    usage "log(x)" if @_ != 1;
+    log($_[0]);
+}
+
+sub pow {
+    usage "pow(x,exponent)" if @_ != 2;
+    $_[0] ** $_[1];
+}
+
+sub sin {
+    usage "sin(x)" if @_ != 1;
+    sin($_[0]);
+}
+
+sub sqrt {
+    usage "sqrt(x)" if @_ != 1;
+    sqrt($_[0]);
+}
+
+sub getpwnam {
+    usage "getpwnam(name)" if @_ != 1;
+    getpwnam($_[0]);
+}
+
+sub getpwuid {
+    usage "getpwuid(uid)" if @_ != 1;
+    getpwuid($_[0]);
+}
+
+sub longjmp {
+    unimpl "longjmp() is C-specific: use die instead";
+}
+
+sub setjmp {
+    unimpl "setjmp() is C-specific: use eval {} instead";
+}
+
+sub siglongjmp {
+    unimpl "siglongjmp() is C-specific: use die instead";
+}
+
+sub sigsetjmp {
+    unimpl "sigsetjmp() is C-specific: use eval {} instead";
+}
+
+sub kill {
+    usage "kill(pid, sig)" if @_ != 2;
+    kill $_[1], $_[0];
+}
+
+sub raise {
+    usage "raise(sig)" if @_ != 1;
+    kill $_[0], $$;	# Is this good enough?
+}
+
+sub offsetof {
+    unimpl "offsetof() is C-specific, stopped";
+}
+
+sub clearerr {
+    redef "IO::Handle::clearerr()";
+}
+
+sub fclose {
+    redef "IO::Handle::close()";
+}
+
+sub fdopen {
+    redef "IO::Handle::new_from_fd()";
+}
+
+sub feof {
+    redef "IO::Handle::eof()";
+}
+
+sub fgetc {
+    redef "IO::Handle::getc()";
+}
+
+sub fgets {
+    redef "IO::Handle::gets()";
+}
+
+sub fileno {
+    redef "IO::Handle::fileno()";
+}
+
+sub fopen {
+    redef "IO::File::open()";
+}
+
+sub fprintf {
+    unimpl "fprintf() is C-specific--use printf instead";
+}
+
+sub fputc {
+    unimpl "fputc() is C-specific--use print instead";
+}
+
+sub fputs {
+    unimpl "fputs() is C-specific--use print instead";
+}
+
+sub fread {
+    unimpl "fread() is C-specific--use read instead";
+}
+
+sub freopen {
+    unimpl "freopen() is C-specific--use open instead";
+}
+
+sub fscanf {
+    unimpl "fscanf() is C-specific--use <> and regular expressions instead";
+}
+
+sub fseek {
+    redef "IO::Seekable::seek()";
+}
+
+sub ferror {
+    redef "IO::Handle::error()";
+}
+
+sub fflush {
+    redef "IO::Handle::flush()";
+}
+
+sub fgetpos {
+    redef "IO::Seekable::getpos()";
+}
+
+sub fsetpos {
+    redef "IO::Seekable::setpos()";
+}
+
+sub ftell {
+    redef "IO::Seekable::tell()";
+}
+
+sub fwrite {
+    unimpl "fwrite() is C-specific--use print instead";
+}
+
+sub getc {
+    usage "getc(handle)" if @_ != 1;
+    getc($_[0]);
+}
+
+sub getchar {
+    usage "getchar()" if @_ != 0;
+    getc(STDIN);
+}
+
+sub gets {
+    usage "gets()" if @_ != 0;
+    scalar <STDIN>;
+}
+
+sub perror {
+    print STDERR "@_: " if @_;
+    print STDERR $!,"\n";
+}
+
+sub printf {
+    usage "printf(pattern, args...)" if @_ < 1;
+    printf STDOUT @_;
+}
+
+sub putc {
+    unimpl "putc() is C-specific--use print instead";
+}
+
+sub putchar {
+    unimpl "putchar() is C-specific--use print instead";
+}
+
+sub puts {
+    unimpl "puts() is C-specific--use print instead";
+}
+
+sub remove {
+    usage "remove(filename)" if @_ != 1;
+    unlink($_[0]);
+}
+
+sub rename {
+    usage "rename(oldfilename, newfilename)" if @_ != 2;
+    rename($_[0], $_[1]);
+}
+
+sub rewind {
+    usage "rewind(filehandle)" if @_ != 1;
+    seek($_[0],0,0);
+}
+
+sub scanf {
+    unimpl "scanf() is C-specific--use <> and regular expressions instead";
+}
+
+sub sprintf {
+    usage "sprintf(pattern,args)" if @_ == 0;
+    sprintf(shift,@_);
+}
+
+sub sscanf {
+    unimpl "sscanf() is C-specific--use regular expressions instead";
+}
+
+sub tmpfile {
+    redef "IO::File::new_tmpfile()";
+}
+
+sub ungetc {
+    redef "IO::Handle::ungetc()";
+}
+
+sub vfprintf {
+    unimpl "vfprintf() is C-specific";
+}
+
+sub vprintf {
+    unimpl "vprintf() is C-specific";
+}
+
+sub vsprintf {
+    unimpl "vsprintf() is C-specific";
+}
+
+sub abs {
+    usage "abs(x)" if @_ != 1;
+    abs($_[0]);
+}
+
+sub atexit {
+    unimpl "atexit() is C-specific: use END {} instead";
+}
+
+sub atof {
+    unimpl "atof() is C-specific, stopped";
+}
+
+sub atoi {
+    unimpl "atoi() is C-specific, stopped";
+}
+
+sub atol {
+    unimpl "atol() is C-specific, stopped";
+}
+
+sub bsearch {
+    unimpl "bsearch() not supplied";
+}
+
+sub calloc {
+    unimpl "calloc() is C-specific, stopped";
+}
+
+sub div {
+    unimpl "div() is C-specific, stopped";
+}
+
+sub exit {
+    usage "exit(status)" if @_ != 1;
+    exit($_[0]);
+}
+
+sub free {
+    unimpl "free() is C-specific, stopped";
+}
+
+sub getenv {
+    usage "getenv(name)" if @_ != 1;
+    $ENV{$_[0]};
+}
+
+sub labs {
+    unimpl "labs() is C-specific, use abs instead";
+}
+
+sub ldiv {
+    unimpl "ldiv() is C-specific, use / and int instead";
+}
+
+sub malloc {
+    unimpl "malloc() is C-specific, stopped";
+}
+
+sub qsort {
+    unimpl "qsort() is C-specific, use sort instead";
+}
+
+sub rand {
+    unimpl "rand() is non-portable, use Perl's rand instead";
+}
+
+sub realloc {
+    unimpl "realloc() is C-specific, stopped";
+}
+
+sub srand {
+    unimpl "srand()";
+}
+
+sub system {
+    usage "system(command)" if @_ != 1;
+    system($_[0]);
+}
+
+sub memchr {
+    unimpl "memchr() is C-specific, use index() instead";
+}
+
+sub memcmp {
+    unimpl "memcmp() is C-specific, use eq instead";
+}
+
+sub memcpy {
+    unimpl "memcpy() is C-specific, use = instead";
+}
+
+sub memmove {
+    unimpl "memmove() is C-specific, use = instead";
+}
+
+sub memset {
+    unimpl "memset() is C-specific, use x instead";
+}
+
+sub strcat {
+    unimpl "strcat() is C-specific, use .= instead";
+}
+
+sub strchr {
+    unimpl "strchr() is C-specific, use index() instead";
+}
+
+sub strcmp {
+    unimpl "strcmp() is C-specific, use eq instead";
+}
+
+sub strcpy {
+    unimpl "strcpy() is C-specific, use = instead";
+}
+
+sub strcspn {
+    unimpl "strcspn() is C-specific, use regular expressions instead";
+}
+
+sub strerror {
+    usage "strerror(errno)" if @_ != 1;
+    local $! = $_[0];
+    $! . "";
+}
+
+sub strlen {
+    unimpl "strlen() is C-specific, use length instead";
+}
+
+sub strncat {
+    unimpl "strncat() is C-specific, use .= instead";
+}
+
+sub strncmp {
+    unimpl "strncmp() is C-specific, use eq instead";
+}
+
+sub strncpy {
+    unimpl "strncpy() is C-specific, use = instead";
+}
+
+sub strpbrk {
+    unimpl "strpbrk() is C-specific, stopped";
+}
+
+sub strrchr {
+    unimpl "strrchr() is C-specific, use rindex() instead";
+}
+
+sub strspn {
+    unimpl "strspn() is C-specific, stopped";
+}
+
+sub strstr {
+    usage "strstr(big, little)" if @_ != 2;
+    index($_[0], $_[1]);
+}
+
+sub strtok {
+    unimpl "strtok() is C-specific, stopped";
+}
+
+sub chmod {
+    usage "chmod(mode, filename)" if @_ != 2;
+    chmod($_[0], $_[1]);
+}
+
+sub fstat {
+    usage "fstat(fd)" if @_ != 1;
+    local *TMP;
+    open(TMP, "<&$_[0]");		# Gross.
+    my @l = stat(TMP);
+    close(TMP);
+    @l;
+}
+
+sub mkdir {
+    usage "mkdir(directoryname, mode)" if @_ != 2;
+    mkdir($_[0], $_[1]);
+}
+
+sub stat {
+    usage "stat(filename)" if @_ != 1;
+    stat($_[0]);
+}
+
+sub umask {
+    usage "umask(mask)" if @_ != 1;
+    umask($_[0]);
+}
+
+sub wait {
+    usage "wait()" if @_ != 0;
+    wait();
+}
+
+sub waitpid {
+    usage "waitpid(pid, options)" if @_ != 2;
+    waitpid($_[0], $_[1]);
+}
+
+sub gmtime {
+    usage "gmtime(time)" if @_ != 1;
+    gmtime($_[0]);
+}
+
+sub localtime {
+    usage "localtime(time)" if @_ != 1;
+    localtime($_[0]);
+}
+
+sub time {
+    usage "time()" if @_ != 0;
+    time;
+}
+
+sub alarm {
+    usage "alarm(seconds)" if @_ != 1;
+    alarm($_[0]);
+}
+
+sub chdir {
+    usage "chdir(directory)" if @_ != 1;
+    chdir($_[0]);
+}
+
+sub chown {
+    usage "chown(filename, uid, gid)" if @_ != 3;
+    chown($_[0], $_[1], $_[2]);
+}
+
+sub execl {
+    unimpl "execl() is C-specific, stopped";
+}
+
+sub execle {
+    unimpl "execle() is C-specific, stopped";
+}
+
+sub execlp {
+    unimpl "execlp() is C-specific, stopped";
+}
+
+sub execv {
+    unimpl "execv() is C-specific, stopped";
+}
+
+sub execve {
+    unimpl "execve() is C-specific, stopped";
+}
+
+sub execvp {
+    unimpl "execvp() is C-specific, stopped";
+}
+
+sub fork {
+    usage "fork()" if @_ != 0;
+    fork;
+}
+
+sub getcwd
+{
+    usage "getcwd()" if @_ != 0;
+    if ($^O eq 'MSWin32') {
+	# this perhaps applies to everyone else also?
+	require Cwd;
+	$cwd = &Cwd::cwd;
+    }
+    else {
+	chop($cwd = `pwd`);
+    }
+    $cwd;
+}
+
+sub getegid {
+    usage "getegid()" if @_ != 0;
+    $) + 0;
+}
+
+sub geteuid {
+    usage "geteuid()" if @_ != 0;
+    $> + 0;
+}
+
+sub getgid {
+    usage "getgid()" if @_ != 0;
+    $( + 0;
+}
+
+sub getgroups {
+    usage "getgroups()" if @_ != 0;
+    my %seen;
+    grep(!$seen{$_}++, split(' ', $) ));
+}
+
+sub getlogin {
+    usage "getlogin()" if @_ != 0;
+    getlogin();
+}
+
+sub getpgrp {
+    usage "getpgrp()" if @_ != 0;
+    getpgrp($_[0]);
+}
+
+sub getpid {
+    usage "getpid()" if @_ != 0;
+    $$;
+}
+
+sub getppid {
+    usage "getppid()" if @_ != 0;
+    getppid;
+}
+
+sub getuid {
+    usage "getuid()" if @_ != 0;
+    $<;
+}
+
+sub isatty {
+    usage "isatty(filehandle)" if @_ != 1;
+    -t $_[0];
+}
+
+sub link {
+    usage "link(oldfilename, newfilename)" if @_ != 2;
+    link($_[0], $_[1]);
+}
+
+sub rmdir {
+    usage "rmdir(directoryname)" if @_ != 1;
+    rmdir($_[0]);
+}
+
+sub setgid {
+    usage "setgid(gid)" if @_ != 1;
+    $( = $_[0];
+}
+
+sub setuid {
+    usage "setuid(uid)" if @_ != 1;
+    $< = $_[0];
+}
+
+sub sleep {
+    usage "sleep(seconds)" if @_ != 1;
+    sleep($_[0]);
+}
+
+sub unlink {
+    usage "unlink(filename)" if @_ != 1;
+    unlink($_[0]);
+}
+
+sub utime {
+    usage "utime(filename, atime, mtime)" if @_ != 3;
+    utime($_[1], $_[2], $_[0]);
+}
+
diff --git a/contrib/perl5/ext/POSIX/POSIX.pod b/contrib/perl5/ext/POSIX/POSIX.pod
new file mode 100644
index 0000000..4726487
--- /dev/null
+++ b/contrib/perl5/ext/POSIX/POSIX.pod
@@ -0,0 +1,1729 @@
+=head1 NAME
+
+POSIX - Perl interface to IEEE Std 1003.1
+
+=head1 SYNOPSIS
+
+    use POSIX;
+    use POSIX qw(setsid);
+    use POSIX qw(:errno_h :fcntl_h);
+
+    printf "EINTR is %d\n", EINTR;
+
+    $sess_id = POSIX::setsid();
+
+    $fd = POSIX::open($path, O_CREAT|O_EXCL|O_WRONLY, 0644);
+	# note: that's a filedescriptor, *NOT* a filehandle
+
+=head1 DESCRIPTION
+
+The POSIX module permits you to access all (or nearly all) the standard
+POSIX 1003.1 identifiers.  Many of these identifiers have been given Perl-ish
+interfaces.  Things which are C<#defines> in C, like EINTR or O_NDELAY, are
+automatically exported into your namespace.  All functions are only exported
+if you ask for them explicitly.  Most likely people will prefer to use the
+fully-qualified function names.
+
+This document gives a condensed list of the features available in the POSIX
+module.  Consult your operating system's manpages for general information on
+most features.  Consult L<perlfunc> for functions which are noted as being
+identical to Perl's builtin functions.
+
+The first section describes POSIX functions from the 1003.1 specification.
+The second section describes some classes for signal objects, TTY objects,
+and other miscellaneous objects.  The remaining sections list various
+constants and macros in an organization which roughly follows IEEE Std
+1003.1b-1993.
+
+=head1 NOTE
+
+The POSIX module is probably the most complex Perl module supplied with
+the standard distribution.  It incorporates autoloading, namespace games,
+and dynamic loading of code that's in Perl, C, or both.  It's a great
+source of wisdom.
+
+=head1 CAVEATS 
+
+A few functions are not implemented because they are C specific.  If you
+attempt to call these, they will print a message telling you that they
+aren't implemented, and suggest using the Perl equivalent should one
+exist.  For example, trying to access the setjmp() call will elicit the
+message "setjmp() is C-specific: use eval {} instead".
+
+Furthermore, some evil vendors will claim 1003.1 compliance, but in fact
+are not so: they will not pass the PCTS (POSIX Compliance Test Suites).
+For example, one vendor may not define EDEADLK, or the semantics of the
+errno values set by open(2) might not be quite right.  Perl does not
+attempt to verify POSIX compliance.  That means you can currently
+successfully say "use POSIX",  and then later in your program you find
+that your vendor has been lax and there's no usable ICANON macro after
+all.  This could be construed to be a bug.
+
+=head1 FUNCTIONS
+
+=over 8
+
+=item _exit
+
+This is identical to the C function C<_exit()>.
+
+=item abort
+
+This is identical to the C function C<abort()>.
+
+=item abs
+
+This is identical to Perl's builtin C<abs()> function.
+
+=item access
+
+Determines the accessibility of a file.
+
+	if( POSIX::access( "/", &POSIX::R_OK ) ){
+		print "have read permission\n";
+	}
+
+Returns C<undef> on failure.
+
+=item acos
+
+This is identical to the C function C<acos()>.
+
+=item alarm
+
+This is identical to Perl's builtin C<alarm()> function.
+
+=item asctime
+
+This is identical to the C function C<asctime()>.
+
+=item asin
+
+This is identical to the C function C<asin()>.
+
+=item assert
+
+Unimplemented.
+
+=item atan
+
+This is identical to the C function C<atan()>.
+
+=item atan2
+
+This is identical to Perl's builtin C<atan2()> function.
+
+=item atexit
+
+atexit() is C-specific: use END {} instead.
+
+=item atof
+
+atof() is C-specific.
+
+=item atoi
+
+atoi() is C-specific.
+
+=item atol
+
+atol() is C-specific.
+
+=item bsearch
+
+bsearch() not supplied.
+
+=item calloc
+
+calloc() is C-specific.
+
+=item ceil
+
+This is identical to the C function C<ceil()>.
+
+=item chdir
+
+This is identical to Perl's builtin C<chdir()> function.
+
+=item chmod
+
+This is identical to Perl's builtin C<chmod()> function.
+
+=item chown
+
+This is identical to Perl's builtin C<chown()> function.
+
+=item clearerr
+
+Use method C<IO::Handle::clearerr()> instead.
+
+=item clock
+
+This is identical to the C function C<clock()>.
+
+=item close
+
+Close the file.  This uses file descriptors such as those obtained by calling
+C<POSIX::open>.
+
+	$fd = POSIX::open( "foo", &POSIX::O_RDONLY );
+	POSIX::close( $fd );
+
+Returns C<undef> on failure.
+
+=item closedir
+
+This is identical to Perl's builtin C<closedir()> function.
+
+=item cos
+
+This is identical to Perl's builtin C<cos()> function.
+
+=item cosh
+
+This is identical to the C function C<cosh()>.
+
+=item creat
+
+Create a new file.  This returns a file descriptor like the ones returned by
+C<POSIX::open>.  Use C<POSIX::close> to close the file.
+
+	$fd = POSIX::creat( "foo", 0611 );
+	POSIX::close( $fd );
+
+=item ctermid
+
+Generates the path name for the controlling terminal.
+
+	$path = POSIX::ctermid();
+
+=item ctime
+
+This is identical to the C function C<ctime()>.
+
+=item cuserid
+
+Get the character login name of the user.
+
+	$name = POSIX::cuserid();
+
+=item difftime
+
+This is identical to the C function C<difftime()>.
+
+=item div
+
+div() is C-specific.
+
+=item dup
+
+This is similar to the C function C<dup()>.
+
+This uses file descriptors such as those obtained by calling
+C<POSIX::open>.
+
+Returns C<undef> on failure.
+
+=item dup2
+
+This is similar to the C function C<dup2()>.
+
+This uses file descriptors such as those obtained by calling
+C<POSIX::open>.
+
+Returns C<undef> on failure.
+
+=item errno
+
+Returns the value of errno.
+
+	$errno = POSIX::errno();
+
+=item execl
+
+execl() is C-specific.
+
+=item execle
+
+execle() is C-specific.
+
+=item execlp
+
+execlp() is C-specific.
+
+=item execv
+
+execv() is C-specific.
+
+=item execve
+
+execve() is C-specific.
+
+=item execvp
+
+execvp() is C-specific.
+
+=item exit
+
+This is identical to Perl's builtin C<exit()> function.
+
+=item exp
+
+This is identical to Perl's builtin C<exp()> function.
+
+=item fabs
+
+This is identical to Perl's builtin C<abs()> function.
+
+=item fclose
+
+Use method C<IO::Handle::close()> instead.
+
+=item fcntl
+
+This is identical to Perl's builtin C<fcntl()> function.
+
+=item fdopen
+
+Use method C<IO::Handle::new_from_fd()> instead.
+
+=item feof
+
+Use method C<IO::Handle::eof()> instead.
+
+=item ferror
+
+Use method C<IO::Handle::error()> instead.
+
+=item fflush
+
+Use method C<IO::Handle::flush()> instead.
+
+=item fgetc
+
+Use method C<IO::Handle::getc()> instead.
+
+=item fgetpos
+
+Use method C<IO::Seekable::getpos()> instead.
+
+=item fgets
+
+Use method C<IO::Handle::gets()> instead.
+
+=item fileno
+
+Use method C<IO::Handle::fileno()> instead.
+
+=item floor
+
+This is identical to the C function C<floor()>.
+
+=item fmod
+
+This is identical to the C function C<fmod()>.
+
+=item fopen
+
+Use method C<IO::File::open()> instead.
+
+=item fork
+
+This is identical to Perl's builtin C<fork()> function.
+
+=item fpathconf
+
+Retrieves the value of a configurable limit on a file or directory.  This
+uses file descriptors such as those obtained by calling C<POSIX::open>.
+
+The following will determine the maximum length of the longest allowable
+pathname on the filesystem which holds C</tmp/foo>.
+
+	$fd = POSIX::open( "/tmp/foo", &POSIX::O_RDONLY );
+	$path_max = POSIX::fpathconf( $fd, &POSIX::_PC_PATH_MAX );
+
+Returns C<undef> on failure.
+
+=item fprintf
+
+fprintf() is C-specific--use printf instead.
+
+=item fputc
+
+fputc() is C-specific--use print instead.
+
+=item fputs
+
+fputs() is C-specific--use print instead.
+
+=item fread
+
+fread() is C-specific--use read instead.
+
+=item free
+
+free() is C-specific.
+
+=item freopen
+
+freopen() is C-specific--use open instead.
+
+=item frexp
+
+Return the mantissa and exponent of a floating-point number.
+
+	($mantissa, $exponent) = POSIX::frexp( 3.14 );
+
+=item fscanf
+
+fscanf() is C-specific--use <> and regular expressions instead.
+
+=item fseek
+
+Use method C<IO::Seekable::seek()> instead.
+
+=item fsetpos
+
+Use method C<IO::Seekable::setpos()> instead.
+
+=item fstat
+
+Get file status.  This uses file descriptors such as those obtained by
+calling C<POSIX::open>.  The data returned is identical to the data from
+Perl's builtin C<stat> function.
+
+	$fd = POSIX::open( "foo", &POSIX::O_RDONLY );
+	@stats = POSIX::fstat( $fd );
+
+=item ftell
+
+Use method C<IO::Seekable::tell()> instead.
+
+=item fwrite
+
+fwrite() is C-specific--use print instead.
+
+=item getc
+
+This is identical to Perl's builtin C<getc()> function.
+
+=item getchar
+
+Returns one character from STDIN.
+
+=item getcwd
+
+Returns the name of the current working directory.
+
+=item getegid
+
+Returns the effective group id.
+
+=item getenv
+
+Returns the value of the specified enironment variable.
+
+=item geteuid
+
+Returns the effective user id.
+
+=item getgid
+
+Returns the user's real group id.
+
+=item getgrgid
+
+This is identical to Perl's builtin C<getgrgid()> function.
+
+=item getgrnam
+
+This is identical to Perl's builtin C<getgrnam()> function.
+
+=item getgroups
+
+Returns the ids of the user's supplementary groups.
+
+=item getlogin
+
+This is identical to Perl's builtin C<getlogin()> function.
+
+=item getpgrp
+
+This is identical to Perl's builtin C<getpgrp()> function.
+
+=item getpid
+
+Returns the process's id.
+
+=item getppid
+
+This is identical to Perl's builtin C<getppid()> function.
+
+=item getpwnam
+
+This is identical to Perl's builtin C<getpwnam()> function.
+
+=item getpwuid
+
+This is identical to Perl's builtin C<getpwuid()> function.
+
+=item gets
+
+Returns one line from STDIN.
+
+=item getuid
+
+Returns the user's id.
+
+=item gmtime
+
+This is identical to Perl's builtin C<gmtime()> function.
+
+=item isalnum
+
+This is identical to the C function, except that it can apply to a single
+character or to a whole string.
+
+=item isalpha
+
+This is identical to the C function, except that it can apply to a single
+character or to a whole string.
+
+=item isatty
+
+Returns a boolean indicating whether the specified filehandle is connected
+to a tty.
+
+=item iscntrl
+
+This is identical to the C function, except that it can apply to a single
+character or to a whole string.
+
+=item isdigit
+
+This is identical to the C function, except that it can apply to a single
+character or to a whole string.
+
+=item isgraph
+
+This is identical to the C function, except that it can apply to a single
+character or to a whole string.
+
+=item islower
+
+This is identical to the C function, except that it can apply to a single
+character or to a whole string.
+
+=item isprint
+
+This is identical to the C function, except that it can apply to a single
+character or to a whole string.
+
+=item ispunct
+
+This is identical to the C function, except that it can apply to a single
+character or to a whole string.
+
+=item isspace
+
+This is identical to the C function, except that it can apply to a single
+character or to a whole string.
+
+=item isupper
+
+This is identical to the C function, except that it can apply to a single
+character or to a whole string.
+
+=item isxdigit
+
+This is identical to the C function, except that it can apply to a single
+character or to a whole string.
+
+=item kill
+
+This is identical to Perl's builtin C<kill()> function.
+
+=item labs
+
+labs() is C-specific, use abs instead.
+
+=item ldexp
+
+This is identical to the C function C<ldexp()>.
+
+=item ldiv
+
+ldiv() is C-specific, use / and int instead.
+
+=item link
+
+This is identical to Perl's builtin C<link()> function.
+
+=item localeconv
+
+Get numeric formatting information.  Returns a reference to a hash
+containing the current locale formatting values.
+
+The database for the B<de> (Deutsch or German) locale.
+
+	$loc = POSIX::setlocale( &POSIX::LC_ALL, "de" );
+	print "Locale = $loc\n";
+	$lconv = POSIX::localeconv();
+	print "decimal_point	= ", $lconv->{decimal_point},	"\n";
+	print "thousands_sep	= ", $lconv->{thousands_sep},	"\n";
+	print "grouping	= ", $lconv->{grouping},	"\n";
+	print "int_curr_symbol	= ", $lconv->{int_curr_symbol},	"\n";
+	print "currency_symbol	= ", $lconv->{currency_symbol},	"\n";
+	print "mon_decimal_point = ", $lconv->{mon_decimal_point}, "\n";
+	print "mon_thousands_sep = ", $lconv->{mon_thousands_sep}, "\n";
+	print "mon_grouping	= ", $lconv->{mon_grouping},	"\n";
+	print "positive_sign	= ", $lconv->{positive_sign},	"\n";
+	print "negative_sign	= ", $lconv->{negative_sign},	"\n";
+	print "int_frac_digits	= ", $lconv->{int_frac_digits},	"\n";
+	print "frac_digits	= ", $lconv->{frac_digits},	"\n";
+	print "p_cs_precedes	= ", $lconv->{p_cs_precedes},	"\n";
+	print "p_sep_by_space	= ", $lconv->{p_sep_by_space},	"\n";
+	print "n_cs_precedes	= ", $lconv->{n_cs_precedes},	"\n";
+	print "n_sep_by_space	= ", $lconv->{n_sep_by_space},	"\n";
+	print "p_sign_posn	= ", $lconv->{p_sign_posn},	"\n";
+	print "n_sign_posn	= ", $lconv->{n_sign_posn},	"\n";
+
+=item localtime
+
+This is identical to Perl's builtin C<localtime()> function.
+
+=item log
+
+This is identical to Perl's builtin C<log()> function.
+
+=item log10
+
+This is identical to the C function C<log10()>.
+
+=item longjmp
+
+longjmp() is C-specific: use die instead.
+
+=item lseek
+
+Move the file's read/write position.  This uses file descriptors such as
+those obtained by calling C<POSIX::open>.
+
+	$fd = POSIX::open( "foo", &POSIX::O_RDONLY );
+	$off_t = POSIX::lseek( $fd, 0, &POSIX::SEEK_SET );
+
+Returns C<undef> on failure.
+
+=item malloc
+
+malloc() is C-specific.
+
+=item mblen
+
+This is identical to the C function C<mblen()>.
+
+=item mbstowcs
+
+This is identical to the C function C<mbstowcs()>.
+
+=item mbtowc
+
+This is identical to the C function C<mbtowc()>.
+
+=item memchr
+
+memchr() is C-specific, use index() instead.
+
+=item memcmp
+
+memcmp() is C-specific, use eq instead.
+
+=item memcpy
+
+memcpy() is C-specific, use = instead.
+
+=item memmove
+
+memmove() is C-specific, use = instead.
+
+=item memset
+
+memset() is C-specific, use x instead.
+
+=item mkdir
+
+This is identical to Perl's builtin C<mkdir()> function.
+
+=item mkfifo
+
+This is similar to the C function C<mkfifo()>.
+
+Returns C<undef> on failure.
+
+=item mktime
+
+Convert date/time info to a calendar time.
+
+Synopsis:
+
+	mktime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = 0)
+
+The month (C<mon>), weekday (C<wday>), and yearday (C<yday>) begin at zero.
+I.e. January is 0, not 1; Sunday is 0, not 1; January 1st is 0, not 1.  The
+year (C<year>) is given in years since 1900.  I.e. The year 1995 is 95; the
+year 2001 is 101.  Consult your system's C<mktime()> manpage for details
+about these and the other arguments.
+
+Calendar time for December 12, 1995, at 10:30 am.
+
+	$time_t = POSIX::mktime( 0, 30, 10, 12, 11, 95 );
+	print "Date = ", POSIX::ctime($time_t);
+
+Returns C<undef> on failure.
+
+=item modf
+
+Return the integral and fractional parts of a floating-point number.
+
+	($fractional, $integral) = POSIX::modf( 3.14 );
+
+=item nice
+
+This is similar to the C function C<nice()>.
+
+Returns C<undef> on failure.
+
+=item offsetof
+
+offsetof() is C-specific.
+
+=item open
+
+Open a file for reading for writing.  This returns file descriptors, not
+Perl filehandles.  Use C<POSIX::close> to close the file.
+
+Open a file read-only with mode 0666.
+
+	$fd = POSIX::open( "foo" );
+
+Open a file for read and write.
+
+	$fd = POSIX::open( "foo", &POSIX::O_RDWR );
+
+Open a file for write, with truncation.
+
+	$fd = POSIX::open( "foo", &POSIX::O_WRONLY | &POSIX::O_TRUNC );
+
+Create a new file with mode 0640.  Set up the file for writing.
+
+	$fd = POSIX::open( "foo", &POSIX::O_CREAT | &POSIX::O_WRONLY, 0640 );
+
+Returns C<undef> on failure.
+
+=item opendir
+
+Open a directory for reading.
+
+	$dir = POSIX::opendir( "/tmp" );
+	@files = POSIX::readdir( $dir );
+	POSIX::closedir( $dir );
+
+Returns C<undef> on failure.
+
+=item pathconf
+
+Retrieves the value of a configurable limit on a file or directory.
+
+The following will determine the maximum length of the longest allowable
+pathname on the filesystem which holds C</tmp>.
+
+	$path_max = POSIX::pathconf( "/tmp", &POSIX::_PC_PATH_MAX );
+
+Returns C<undef> on failure.
+
+=item pause
+
+This is similar to the C function C<pause()>.
+
+Returns C<undef> on failure.
+
+=item perror
+
+This is identical to the C function C<perror()>.
+
+=item pipe
+
+Create an interprocess channel.  This returns file descriptors like those
+returned by C<POSIX::open>.
+
+	($fd0, $fd1) = POSIX::pipe();
+	POSIX::write( $fd0, "hello", 5 );
+	POSIX::read( $fd1, $buf, 5 );
+
+=item pow
+
+Computes $x raised to the power $exponent.
+
+	$ret = POSIX::pow( $x, $exponent );
+
+=item printf
+
+Prints the specified arguments to STDOUT.
+
+=item putc
+
+putc() is C-specific--use print instead.
+
+=item putchar
+
+putchar() is C-specific--use print instead.
+
+=item puts
+
+puts() is C-specific--use print instead.
+
+=item qsort
+
+qsort() is C-specific, use sort instead.
+
+=item raise
+
+Sends the specified signal to the current process.
+
+=item rand
+
+rand() is non-portable, use Perl's rand instead.
+
+=item read
+
+Read from a file.  This uses file descriptors such as those obtained by
+calling C<POSIX::open>.  If the buffer C<$buf> is not large enough for the
+read then Perl will extend it to make room for the request.
+
+	$fd = POSIX::open( "foo", &POSIX::O_RDONLY );
+	$bytes = POSIX::read( $fd, $buf, 3 );
+
+Returns C<undef> on failure.
+
+=item readdir
+
+This is identical to Perl's builtin C<readdir()> function.
+
+=item realloc
+
+realloc() is C-specific.
+
+=item remove
+
+This is identical to Perl's builtin C<unlink()> function.
+
+=item rename
+
+This is identical to Perl's builtin C<rename()> function.
+
+=item rewind
+
+Seeks to the beginning of the file.
+
+=item rewinddir
+
+This is identical to Perl's builtin C<rewinddir()> function.
+
+=item rmdir
+
+This is identical to Perl's builtin C<rmdir()> function.
+
+=item scanf
+
+scanf() is C-specific--use <> and regular expressions instead.
+
+=item setgid
+
+Sets the real group id for this process.
+
+=item setjmp
+
+setjmp() is C-specific: use eval {} instead.
+
+=item setlocale
+
+Modifies and queries program's locale.
+
+The following will set the traditional UNIX system locale behavior
+(the second argument C<"C">).
+
+	$loc = POSIX::setlocale( &POSIX::LC_ALL, "C" );
+
+The following will query (the missing second argument) the current
+LC_CTYPE category.
+
+	$loc = POSIX::setlocale( &POSIX::LC_CTYPE);
+
+The following will set the LC_CTYPE behaviour according to the locale
+environment variables (the second argument C<"">).
+Please see your systems L<setlocale(3)> documentation for the locale
+environment variables' meaning or consult L<perllocale>.
+
+	$loc = POSIX::setlocale( &POSIX::LC_CTYPE, "");
+
+The following will set the LC_COLLATE behaviour to Argentinian
+Spanish. B<NOTE>: The naming and availability of locales depends on
+your operating system. Please consult L<perllocale> for how to find
+out which locales are available in your system.
+
+	$loc = POSIX::setlocale( &POSIX::LC_ALL, "es_AR.ISO8859-1" );
+
+=item setpgid
+
+This is similar to the C function C<setpgid()>.
+
+Returns C<undef> on failure.
+
+=item setsid
+
+This is identical to the C function C<setsid()>.
+
+=item setuid
+
+Sets the real user id for this process.
+
+=item sigaction
+
+Detailed signal management.  This uses C<POSIX::SigAction> objects for the
+C<action> and C<oldaction> arguments.  Consult your system's C<sigaction>
+manpage for details.
+
+Synopsis:
+
+	sigaction(sig, action, oldaction = 0)
+
+Returns C<undef> on failure.
+
+=item siglongjmp
+
+siglongjmp() is C-specific: use die instead.
+
+=item sigpending
+
+Examine signals that are blocked and pending.  This uses C<POSIX::SigSet>
+objects for the C<sigset> argument.  Consult your system's C<sigpending>
+manpage for details.
+
+Synopsis:
+
+	sigpending(sigset)
+
+Returns C<undef> on failure.
+
+=item sigprocmask
+
+Change and/or examine calling process's signal mask.  This uses
+C<POSIX::SigSet> objects for the C<sigset> and C<oldsigset> arguments.
+Consult your system's C<sigprocmask> manpage for details.
+
+Synopsis:
+
+	sigprocmask(how, sigset, oldsigset = 0)
+
+Returns C<undef> on failure.
+
+=item sigsetjmp
+
+sigsetjmp() is C-specific: use eval {} instead.
+
+=item sigsuspend
+
+Install a signal mask and suspend process until signal arrives.  This uses
+C<POSIX::SigSet> objects for the C<signal_mask> argument.  Consult your
+system's C<sigsuspend> manpage for details.
+
+Synopsis:
+
+	sigsuspend(signal_mask)
+
+Returns C<undef> on failure.
+
+=item sin
+
+This is identical to Perl's builtin C<sin()> function.
+
+=item sinh
+
+This is identical to the C function C<sinh()>.
+
+=item sleep
+
+This is identical to Perl's builtin C<sleep()> function.
+
+=item sprintf
+
+This is identical to Perl's builtin C<sprintf()> function.
+
+=item sqrt
+
+This is identical to Perl's builtin C<sqrt()> function.
+
+=item srand
+
+srand().
+
+=item sscanf
+
+sscanf() is C-specific--use regular expressions instead.
+
+=item stat
+
+This is identical to Perl's builtin C<stat()> function.
+
+=item strcat
+
+strcat() is C-specific, use .= instead.
+
+=item strchr
+
+strchr() is C-specific, use index() instead.
+
+=item strcmp
+
+strcmp() is C-specific, use eq instead.
+
+=item strcoll
+
+This is identical to the C function C<strcoll()>.
+
+=item strcpy
+
+strcpy() is C-specific, use = instead.
+
+=item strcspn
+
+strcspn() is C-specific, use regular expressions instead.
+
+=item strerror
+
+Returns the error string for the specified errno.
+
+=item strftime
+
+Convert date and time information to string.  Returns the string.
+
+Synopsis:
+
+	strftime(fmt, sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = 0)
+
+The month (C<mon>), weekday (C<wday>), and yearday (C<yday>) begin at zero.
+I.e. January is 0, not 1; Sunday is 0, not 1; January 1st is 0, not 1.  The
+year (C<year>) is given in years since 1900.  I.e. The year 1995 is 95; the
+year 2001 is 101.  Consult your system's C<strftime()> manpage for details
+about these and the other arguments.
+
+The string for Tuesday, December 12, 1995.
+
+	$str = POSIX::strftime( "%A, %B %d, %Y", 0, 0, 0, 12, 11, 95, 2 );
+	print "$str\n";
+
+=item strlen
+
+strlen() is C-specific, use length instead.
+
+=item strncat
+
+strncat() is C-specific, use .= instead.
+
+=item strncmp
+
+strncmp() is C-specific, use eq instead.
+
+=item strncpy
+
+strncpy() is C-specific, use = instead.
+
+=item stroul
+
+stroul() is C-specific.
+
+=item strpbrk
+
+strpbrk() is C-specific.
+
+=item strrchr
+
+strrchr() is C-specific, use rindex() instead.
+
+=item strspn
+
+strspn() is C-specific.
+
+=item strstr
+
+This is identical to Perl's builtin C<index()> function.
+
+=item strtod
+
+String to double translation. Returns the parsed number and the number
+of characters in the unparsed portion of the string.  Truly
+POSIX-compliant systems set $! ($ERRNO) to indicate a translation
+error, so clear $! before calling strtod.  However, non-POSIX systems
+may not check for overflow, and therefore will never set $!.
+
+strtod should respect any POSIX I<setlocale()> settings.
+
+To parse a string $str as a floating point number use
+
+    $! = 0;
+    ($num, $n_unparsed) = POSIX::strtod($str);
+
+The second returned item and $! can be used to check for valid input:
+
+    if (($str eq '') || ($n_unparsed != 0) || !$!) {
+        die "Non-numeric input $str" . $! ? ": $!\n" : "\n";
+    }
+
+When called in a scalar context strtod returns the parsed number.
+
+=item strtok
+
+strtok() is C-specific.
+
+=item strtol
+
+String to (long) integer translation.  Returns the parsed number and
+the number of characters in the unparsed portion of the string.  Truly
+POSIX-compliant systems set $! ($ERRNO) to indicate a translation
+error, so clear $! before calling strtol.  However, non-POSIX systems
+may not check for overflow, and therefore will never set $!.
+
+strtol should respect any POSIX I<setlocale()> settings.
+
+To parse a string $str as a number in some base $base use
+
+    $! = 0;
+    ($num, $n_unparsed) = POSIX::strtol($str, $base);
+
+The base should be zero or between 2 and 36, inclusive.  When the base
+is zero or omitted strtol will use the string itself to determine the
+base: a leading "0x" or "0X" means hexadecimal; a leading "0" means
+octal; any other leading characters mean decimal.  Thus, "1234" is
+parsed as a decimal number, "01234" as an octal number, and "0x1234"
+as a hexadecimal number.
+
+The second returned item and $! can be used to check for valid input:
+
+    if (($str eq '') || ($n_unparsed != 0) || !$!) {
+        die "Non-numeric input $str" . $! ? ": $!\n" : "\n";
+    }
+
+When called in a scalar context strtol returns the parsed number.
+
+=item strtoul
+
+String to unsigned (long) integer translation.  strtoul is identical
+to strtol except that strtoul only parses unsigned integers.  See
+I<strtol> for details.
+
+Note: Some vendors supply strtod and strtol but not strtoul.
+Other vendors that do suply strtoul parse "-1" as a valid value.
+
+=item strxfrm
+
+String transformation.  Returns the transformed string.
+
+	$dst = POSIX::strxfrm( $src );
+
+=item sysconf
+
+Retrieves values of system configurable variables.
+
+The following will get the machine's clock speed.
+
+	$clock_ticks = POSIX::sysconf( &POSIX::_SC_CLK_TCK );
+
+Returns C<undef> on failure.
+
+=item system
+
+This is identical to Perl's builtin C<system()> function.
+
+=item tan
+
+This is identical to the C function C<tan()>.
+
+=item tanh
+
+This is identical to the C function C<tanh()>.
+
+=item tcdrain
+
+This is similar to the C function C<tcdrain()>.
+
+Returns C<undef> on failure.
+
+=item tcflow
+
+This is similar to the C function C<tcflow()>.
+
+Returns C<undef> on failure.
+
+=item tcflush
+
+This is similar to the C function C<tcflush()>.
+
+Returns C<undef> on failure.
+
+=item tcgetpgrp
+
+This is identical to the C function C<tcgetpgrp()>.
+
+=item tcsendbreak
+
+This is similar to the C function C<tcsendbreak()>.
+
+Returns C<undef> on failure.
+
+=item tcsetpgrp
+
+This is similar to the C function C<tcsetpgrp()>.
+
+Returns C<undef> on failure.
+
+=item time
+
+This is identical to Perl's builtin C<time()> function.
+
+=item times
+
+The times() function returns elapsed realtime since some point in the past
+(such as system startup), user and system times for this process, and user
+and system times used by child processes.  All times are returned in clock
+ticks.
+
+    ($realtime, $user, $system, $cuser, $csystem) = POSIX::times();
+
+Note: Perl's builtin C<times()> function returns four values, measured in
+seconds.
+
+=item tmpfile
+
+Use method C<IO::File::new_tmpfile()> instead.
+
+=item tmpnam
+
+Returns a name for a temporary file.
+
+	$tmpfile = POSIX::tmpnam();
+
+=item tolower
+
+This is identical to Perl's builtin C<lc()> function.
+
+=item toupper
+
+This is identical to Perl's builtin C<uc()> function.
+
+=item ttyname
+
+This is identical to the C function C<ttyname()>.
+
+=item tzname
+
+Retrieves the time conversion information from the C<tzname> variable.
+
+	POSIX::tzset();
+	($std, $dst) = POSIX::tzname();
+
+=item tzset
+
+This is identical to the C function C<tzset()>.
+
+=item umask
+
+This is identical to Perl's builtin C<umask()> function.
+
+=item uname
+
+Get name of current operating system.
+
+	($sysname, $nodename, $release, $version, $machine ) = POSIX::uname();
+
+=item ungetc
+
+Use method C<IO::Handle::ungetc()> instead.
+
+=item unlink
+
+This is identical to Perl's builtin C<unlink()> function.
+
+=item utime
+
+This is identical to Perl's builtin C<utime()> function.
+
+=item vfprintf
+
+vfprintf() is C-specific.
+
+=item vprintf
+
+vprintf() is C-specific.
+
+=item vsprintf
+
+vsprintf() is C-specific.
+
+=item wait
+
+This is identical to Perl's builtin C<wait()> function.
+
+=item waitpid
+
+Wait for a child process to change state.  This is identical to Perl's
+builtin C<waitpid()> function.
+
+	$pid = POSIX::waitpid( -1, &POSIX::WNOHANG );
+	print "status = ", ($? / 256), "\n";
+
+=item wcstombs
+
+This is identical to the C function C<wcstombs()>.
+
+=item wctomb
+
+This is identical to the C function C<wctomb()>.
+
+=item write
+
+Write to a file.  This uses file descriptors such as those obtained by
+calling C<POSIX::open>.
+
+	$fd = POSIX::open( "foo", &POSIX::O_WRONLY );
+	$buf = "hello";
+	$bytes = POSIX::write( $b, $buf, 5 );
+
+Returns C<undef> on failure.
+
+=back
+
+=head1 CLASSES
+
+=head2 POSIX::SigAction
+
+=over 8
+
+=item new
+
+Creates a new C<POSIX::SigAction> object which corresponds to the C
+C<struct sigaction>.  This object will be destroyed automatically when it is
+no longer needed.  The first parameter is the fully-qualified name of a sub
+which is a signal-handler.  The second parameter is a C<POSIX::SigSet>
+object, it defaults to the empty set.  The third parameter contains the
+C<sa_flags>, it defaults to 0.
+
+	$sigset = POSIX::SigSet->new(SIGINT, SIGQUIT);
+	$sigaction = POSIX::SigAction->new( 'main::handler', $sigset, &POSIX::SA_NOCLDSTOP );
+
+This C<POSIX::SigAction> object should be used with the C<POSIX::sigaction()>
+function.
+
+=back
+
+=head2 POSIX::SigSet
+
+=over 8
+
+=item new
+
+Create a new SigSet object.  This object will be destroyed automatically
+when it is no longer needed.  Arguments may be supplied to initialize the
+set.
+
+Create an empty set.
+
+	$sigset = POSIX::SigSet->new;
+
+Create a set with SIGUSR1.
+
+	$sigset = POSIX::SigSet->new( &POSIX::SIGUSR1 );
+
+=item addset
+
+Add a signal to a SigSet object.
+
+	$sigset->addset( &POSIX::SIGUSR2 );
+
+Returns C<undef> on failure.
+
+=item delset
+
+Remove a signal from the SigSet object.
+
+	$sigset->delset( &POSIX::SIGUSR2 );
+
+Returns C<undef> on failure.
+
+=item emptyset
+
+Initialize the SigSet object to be empty.
+
+	$sigset->emptyset();
+
+Returns C<undef> on failure.
+
+=item fillset
+
+Initialize the SigSet object to include all signals.
+
+	$sigset->fillset();
+
+Returns C<undef> on failure.
+
+=item ismember
+
+Tests the SigSet object to see if it contains a specific signal.
+
+	if( $sigset->ismember( &POSIX::SIGUSR1 ) ){
+		print "contains SIGUSR1\n";
+	}
+
+=back
+
+=head2 POSIX::Termios
+
+=over 8
+
+=item new
+
+Create a new Termios object.  This object will be destroyed automatically
+when it is no longer needed.  A Termios object corresponds to the termios
+C struct.  new() mallocs a new one, getattr() fills it from a file descriptor,
+and setattr() sets a file descriptor's parameters to match Termios' contents.
+
+	$termios = POSIX::Termios->new;
+
+=item getattr
+
+Get terminal control attributes.
+
+Obtain the attributes for stdin.
+
+	$termios->getattr()
+
+Obtain the attributes for stdout.
+
+	$termios->getattr( 1 )
+
+Returns C<undef> on failure.
+
+=item getcc
+
+Retrieve a value from the c_cc field of a termios object.  The c_cc field is
+an array so an index must be specified.
+
+	$c_cc[1] = $termios->getcc(1);
+
+=item getcflag
+
+Retrieve the c_cflag field of a termios object.
+
+	$c_cflag = $termios->getcflag;
+
+=item getiflag
+
+Retrieve the c_iflag field of a termios object.
+
+	$c_iflag = $termios->getiflag;
+
+=item getispeed
+
+Retrieve the input baud rate.
+
+	$ispeed = $termios->getispeed;
+
+=item getlflag
+
+Retrieve the c_lflag field of a termios object.
+
+	$c_lflag = $termios->getlflag;
+
+=item getoflag
+
+Retrieve the c_oflag field of a termios object.
+
+	$c_oflag = $termios->getoflag;
+
+=item getospeed
+
+Retrieve the output baud rate.
+
+	$ospeed = $termios->getospeed;
+
+=item setattr
+
+Set terminal control attributes.
+
+Set attributes immediately for stdout.
+
+	$termios->setattr( 1, &POSIX::TCSANOW );
+
+Returns C<undef> on failure.
+
+=item setcc
+
+Set a value in the c_cc field of a termios object.  The c_cc field is an
+array so an index must be specified.
+
+	$termios->setcc( &POSIX::VEOF, 1 );
+
+=item setcflag
+
+Set the c_cflag field of a termios object.
+
+	$termios->setcflag( $c_cflag | &POSIX::CLOCAL );
+
+=item setiflag
+
+Set the c_iflag field of a termios object.
+
+	$termios->setiflag( $c_iflag | &POSIX::BRKINT );
+
+=item setispeed
+
+Set the input baud rate.
+
+	$termios->setispeed( &POSIX::B9600 );
+
+Returns C<undef> on failure.
+
+=item setlflag
+
+Set the c_lflag field of a termios object.
+
+	$termios->setlflag( $c_lflag | &POSIX::ECHO );
+
+=item setoflag
+
+Set the c_oflag field of a termios object.
+
+	$termios->setoflag( $c_oflag | &POSIX::OPOST );
+
+=item setospeed
+
+Set the output baud rate.
+
+	$termios->setospeed( &POSIX::B9600 );
+
+Returns C<undef> on failure.
+
+=item Baud rate values
+
+B38400 B75 B200 B134 B300 B1800 B150 B0 B19200 B1200 B9600 B600 B4800 B50 B2400 B110
+
+=item Terminal interface values
+
+TCSADRAIN TCSANOW TCOON TCIOFLUSH TCOFLUSH TCION TCIFLUSH TCSAFLUSH TCIOFF TCOOFF
+
+=item c_cc field values
+
+VEOF VEOL VERASE VINTR VKILL VQUIT VSUSP VSTART VSTOP VMIN VTIME NCCS
+
+=item c_cflag field values
+
+CLOCAL CREAD CSIZE CS5 CS6 CS7 CS8 CSTOPB HUPCL PARENB PARODD
+
+=item c_iflag field values
+
+BRKINT ICRNL IGNBRK IGNCR IGNPAR INLCR INPCK ISTRIP IXOFF IXON PARMRK
+
+=item c_lflag field values
+
+ECHO ECHOE ECHOK ECHONL ICANON IEXTEN ISIG NOFLSH TOSTOP
+
+=item c_oflag field values
+
+OPOST
+
+=back
+
+=head1 PATHNAME CONSTANTS
+
+=over 8
+
+=item Constants
+
+_PC_CHOWN_RESTRICTED _PC_LINK_MAX _PC_MAX_CANON _PC_MAX_INPUT _PC_NAME_MAX _PC_NO_TRUNC _PC_PATH_MAX _PC_PIPE_BUF _PC_VDISABLE
+
+=back
+
+=head1 POSIX CONSTANTS
+
+=over 8
+
+=item Constants
+
+_POSIX_ARG_MAX _POSIX_CHILD_MAX _POSIX_CHOWN_RESTRICTED _POSIX_JOB_CONTROL _POSIX_LINK_MAX _POSIX_MAX_CANON _POSIX_MAX_INPUT _POSIX_NAME_MAX _POSIX_NGROUPS_MAX _POSIX_NO_TRUNC _POSIX_OPEN_MAX _POSIX_PATH_MAX _POSIX_PIPE_BUF _POSIX_SAVED_IDS _POSIX_SSIZE_MAX _POSIX_STREAM_MAX _POSIX_TZNAME_MAX _POSIX_VDISABLE _POSIX_VERSION
+
+=back
+
+=head1 SYSTEM CONFIGURATION
+
+=over 8
+
+=item Constants
+
+_SC_ARG_MAX _SC_CHILD_MAX _SC_CLK_TCK _SC_JOB_CONTROL _SC_NGROUPS_MAX _SC_OPEN_MAX _SC_SAVED_IDS _SC_STREAM_MAX _SC_TZNAME_MAX _SC_VERSION
+
+=back
+
+=head1 ERRNO
+
+=over 8
+
+=item Constants
+
+E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EAFNOSUPPORT EAGAIN EALREADY EBADF
+EBUSY ECHILD ECONNABORTED ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ
+EDOM EDQUOT EEXIST EFAULT EFBIG EHOSTDOWN EHOSTUNREACH EINPROGRESS EINTR
+EINVAL EIO EISCONN EISDIR ELOOP EMFILE EMLINK EMSGSIZE ENAMETOOLONG
+ENETDOWN ENETRESET ENETUNREACH ENFILE ENOBUFS ENODEV ENOENT ENOEXEC
+ENOLCK ENOMEM ENOPROTOOPT ENOSPC ENOSYS ENOTBLK ENOTCONN ENOTDIR
+ENOTEMPTY ENOTSOCK ENOTTY ENXIO EOPNOTSUPP EPERM EPFNOSUPPORT EPIPE
+EPROCLIM EPROTONOSUPPORT EPROTOTYPE ERANGE EREMOTE ERESTART EROFS
+ESHUTDOWN ESOCKTNOSUPPORT ESPIPE ESRCH ESTALE ETIMEDOUT ETOOMANYREFS
+ETXTBSY EUSERS EWOULDBLOCK EXDEV
+
+=back
+
+=head1 FCNTL
+
+=over 8
+
+=item Constants
+
+FD_CLOEXEC F_DUPFD F_GETFD F_GETFL F_GETLK F_OK F_RDLCK F_SETFD F_SETFL F_SETLK F_SETLKW F_UNLCK F_WRLCK O_ACCMODE O_APPEND O_CREAT O_EXCL O_NOCTTY O_NONBLOCK O_RDONLY O_RDWR O_TRUNC O_WRONLY
+
+=back
+
+=head1 FLOAT
+
+=over 8
+
+=item Constants
+
+DBL_DIG DBL_EPSILON DBL_MANT_DIG DBL_MAX DBL_MAX_10_EXP DBL_MAX_EXP DBL_MIN DBL_MIN_10_EXP DBL_MIN_EXP FLT_DIG FLT_EPSILON FLT_MANT_DIG FLT_MAX FLT_MAX_10_EXP FLT_MAX_EXP FLT_MIN FLT_MIN_10_EXP FLT_MIN_EXP FLT_RADIX FLT_ROUNDS LDBL_DIG LDBL_EPSILON LDBL_MANT_DIG LDBL_MAX LDBL_MAX_10_EXP LDBL_MAX_EXP LDBL_MIN LDBL_MIN_10_EXP LDBL_MIN_EXP
+
+=back
+
+=head1 LIMITS
+
+=over 8
+
+=item Constants
+
+ARG_MAX CHAR_BIT CHAR_MAX CHAR_MIN CHILD_MAX INT_MAX INT_MIN LINK_MAX LONG_MAX LONG_MIN MAX_CANON MAX_INPUT MB_LEN_MAX NAME_MAX NGROUPS_MAX OPEN_MAX PATH_MAX PIPE_BUF SCHAR_MAX SCHAR_MIN SHRT_MAX SHRT_MIN SSIZE_MAX STREAM_MAX TZNAME_MAX UCHAR_MAX UINT_MAX ULONG_MAX USHRT_MAX
+
+=back
+
+=head1 LOCALE
+
+=over 8
+
+=item Constants
+
+LC_ALL LC_COLLATE LC_CTYPE LC_MONETARY LC_NUMERIC LC_TIME
+
+=back
+
+=head1 MATH
+
+=over 8
+
+=item Constants
+
+HUGE_VAL
+
+=back
+
+=head1 SIGNAL
+
+=over 8
+
+=item Constants
+
+SA_NOCLDSTOP SA_NOCLDWAIT SA_NODEFER SA_ONSTACK SA_RESETHAND SA_RESTART
+SA_SIGINFO SIGABRT SIGALRM SIGCHLD SIGCONT SIGFPE SIGHUP SIGILL SIGINT
+SIGKILL SIGPIPE SIGQUIT SIGSEGV SIGSTOP SIGTERM SIGTSTP SIGTTIN SIGTTOU
+SIGUSR1 SIGUSR2 SIG_BLOCK SIG_DFL SIG_ERR SIG_IGN SIG_SETMASK
+SIG_UNBLOCK
+
+=back
+
+=head1 STAT
+
+=over 8
+
+=item Constants
+
+S_IRGRP S_IROTH S_IRUSR S_IRWXG S_IRWXO S_IRWXU S_ISGID S_ISUID S_IWGRP S_IWOTH S_IWUSR S_IXGRP S_IXOTH S_IXUSR
+
+=item Macros
+
+S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISREG
+
+=back
+
+=head1 STDLIB
+
+=over 8
+
+=item Constants
+
+EXIT_FAILURE EXIT_SUCCESS MB_CUR_MAX RAND_MAX
+
+=back
+
+=head1 STDIO
+
+=over 8
+
+=item Constants
+
+BUFSIZ EOF FILENAME_MAX L_ctermid L_cuserid L_tmpname TMP_MAX
+
+=back
+
+=head1 TIME
+
+=over 8
+
+=item Constants
+
+CLK_TCK CLOCKS_PER_SEC
+
+=back
+
+=head1 UNISTD
+
+=over 8
+
+=item Constants
+
+R_OK SEEK_CUR SEEK_END SEEK_SET STDIN_FILENO STDOUT_FILENO STRERR_FILENO W_OK X_OK
+
+=back
+
+=head1 WAIT
+
+=over 8
+
+=item Constants
+
+WNOHANG WUNTRACED
+
+=item Macros
+
+WIFEXITED WEXITSTATUS WIFSIGNALED WTERMSIG WIFSTOPPED WSTOPSIG
+
+=back
+
+=head1 CREATION
+
+This document generated by ./mkposixman.PL version 19960129.
+
diff --git a/contrib/perl5/ext/POSIX/POSIX.xs b/contrib/perl5/ext/POSIX/POSIX.xs
new file mode 100644
index 0000000..6958c00
--- /dev/null
+++ b/contrib/perl5/ext/POSIX/POSIX.xs
@@ -0,0 +1,3666 @@
+#ifdef WIN32
+#define _POSIX_
+#endif
+#include "EXTERN.h"
+#define PERLIO_NOT_STDIO 1
+#include "perl.h"
+#include "XSUB.h"
+#ifdef PERL_OBJECT	/* XXX _very_ temporary hacks */
+#  undef signal
+#  undef open
+#  undef setmode
+#  define open PerlLIO_open3
+#  undef TAINT_PROPER
+#  define TAINT_PROPER(a)
+#endif
+#include <ctype.h>
+#ifdef I_DIRENT    /* XXX maybe better to just rely on perl.h? */
+#include <dirent.h>
+#endif
+#include <errno.h>
+#ifdef I_FLOAT
+#include <float.h>
+#endif
+#ifdef I_LIMITS
+#include <limits.h>
+#endif
+#include <locale.h>
+#include <math.h>
+#ifdef I_PWD
+#include <pwd.h>
+#endif
+#include <setjmp.h>
+#include <signal.h>
+#include <stdarg.h>
+
+#ifdef I_STDDEF
+#include <stddef.h>
+#endif
+
+/* XXX This comment is just to make I_TERMIO and I_SGTTY visible to 
+   metaconfig for future extension writers.  We don't use them in POSIX.
+   (This is really sneaky :-)  --AD
+*/
+#if defined(I_TERMIOS)
+#include <termios.h>
+#endif
+#ifdef I_STDLIB
+#include <stdlib.h>
+#endif
+#include <string.h>
+#include <sys/stat.h>
+#include <sys/types.h>
+#include <time.h>
+#ifdef I_UNISTD
+#include <unistd.h>
+#endif
+#include <fcntl.h>
+
+#if defined(__VMS) && !defined(__POSIX_SOURCE)
+#  include <libdef.h>       /* LIB$_INVARG constant */
+#  include <lib$routines.h> /* prototype for lib$ediv() */
+#  include <starlet.h>      /* prototype for sys$gettim() */
+#  if DECC_VERSION < 50000000
+#    define pid_t int       /* old versions of DECC miss this in types.h */
+#  endif
+
+#  undef mkfifo
+#  define mkfifo(a,b) (not_here("mkfifo"),-1)
+#  define tzset() not_here("tzset")
+
+#if ((__VMS_VER >= 70000000) && (__DECC_VER >= 50200000)) || (__CRTL_VER >= 70000000)
+#    define HAS_TZNAME  /* shows up in VMS 7.0 or Dec C 5.6 */
+#    include <utsname.h>
+#  endif /* __VMS_VER >= 70000000 or Dec C 5.6 */
+
+   /* The POSIX notion of ttyname() is better served by getname() under VMS */
+   static char ttnambuf[64];
+#  define ttyname(fd) (isatty(fd) > 0 ? getname(fd,ttnambuf,0) : NULL)
+
+   /* The non-POSIX CRTL times() has void return type, so we just get the
+      current time directly */
+   clock_t vms_times(struct tms *PL_bufptr) {
+	clock_t retval;
+	/* Get wall time and convert to 10 ms intervals to
+	 * produce the return value that the POSIX standard expects */
+#  if defined(__DECC) && defined (__ALPHA)
+#    include <ints.h>
+	uint64 vmstime;
+	_ckvmssts(sys$gettim(&vmstime));
+	vmstime /= 100000;
+	retval = vmstime & 0x7fffffff;
+#  else
+	/* (Older hw or ccs don't have an atomic 64-bit type, so we
+	 * juggle 32-bit ints (and a float) to produce a time_t result
+	 * with minimal loss of information.) */
+	long int vmstime[2],remainder,divisor = 100000;
+	_ckvmssts(sys$gettim((unsigned long int *)vmstime));
+	vmstime[1] &= 0x7fff;  /* prevent overflow in EDIV */
+	_ckvmssts(lib$ediv(&divisor,vmstime,(long int *)&retval,&remainder));
+#  endif
+	/* Fill in the struct tms using the CRTL routine . . .*/
+	times((tbuffer_t *)PL_bufptr);
+	return (clock_t) retval;
+   }
+#  define times(t) vms_times(t)
+#else
+#if defined (WIN32)
+#  undef mkfifo
+#  define mkfifo(a,b) not_here("mkfifo")
+#  define ttyname(a) (char*)not_here("ttyname")
+#  define sigset_t long
+#  define pid_t long
+#  ifdef __BORLANDC__
+#    define tzname _tzname
+#  endif
+#  ifdef _MSC_VER
+#    define mode_t short
+#  endif
+#  ifdef __MINGW32__
+#    define mode_t short
+#    ifndef tzset
+#      define tzset()		not_here("tzset")
+#    endif
+#    ifndef _POSIX_OPEN_MAX
+#      define _POSIX_OPEN_MAX	FOPEN_MAX	/* XXX bogus ? */
+#    endif
+#  endif
+#  define sigaction(a,b,c)	not_here("sigaction")
+#  define sigpending(a)		not_here("sigpending")
+#  define sigprocmask(a,b,c)	not_here("sigprocmask")
+#  define sigsuspend(a)		not_here("sigsuspend")
+#  define sigemptyset(a)	not_here("sigemptyset")
+#  define sigaddset(a,b)	not_here("sigaddset")
+#  define sigdelset(a,b)	not_here("sigdelset")
+#  define sigfillset(a)		not_here("sigfillset")
+#  define sigismember(a,b)	not_here("sigismember")
+#else
+
+#  ifndef HAS_MKFIFO
+#    ifndef mkfifo
+#      define mkfifo(path, mode) (mknod((path), (mode) | S_IFIFO, 0))
+#    endif
+#  endif /* !HAS_MKFIFO */
+
+#  include <grp.h>
+#  include <sys/times.h>
+#  ifdef HAS_UNAME
+#    include <sys/utsname.h>
+#  endif
+#  include <sys/wait.h>
+#  ifdef I_UTIME
+#    include <utime.h>
+#  endif
+#endif /* WIN32 */
+#endif /* __VMS */
+
+typedef int SysRet;
+typedef long SysRetLong;
+typedef sigset_t* POSIX__SigSet;
+typedef HV* POSIX__SigAction;
+#ifdef I_TERMIOS
+typedef struct termios* POSIX__Termios;
+#else /* Define termios types to int, and call not_here for the functions.*/
+#define POSIX__Termios int
+#define speed_t int
+#define tcflag_t int
+#define cc_t int
+#define cfgetispeed(x) not_here("cfgetispeed")
+#define cfgetospeed(x) not_here("cfgetospeed")
+#define tcdrain(x) not_here("tcdrain")
+#define tcflush(x,y) not_here("tcflush")
+#define tcsendbreak(x,y) not_here("tcsendbreak")
+#define cfsetispeed(x,y) not_here("cfsetispeed")
+#define cfsetospeed(x,y) not_here("cfsetospeed")
+#define ctermid(x) (char *) not_here("ctermid")
+#define tcflow(x,y) not_here("tcflow")
+#define tcgetattr(x,y) not_here("tcgetattr")
+#define tcsetattr(x,y,z) not_here("tcsetattr")
+#endif
+
+/* Possibly needed prototypes */
+char *cuserid _((char *));
+double strtod _((const char *, char **));
+long strtol _((const char *, char **, int));
+unsigned long strtoul _((const char *, char **, int));
+
+#ifndef HAS_CUSERID
+#define cuserid(a) (char *) not_here("cuserid")
+#endif
+#ifndef HAS_DIFFTIME
+#ifndef difftime
+#define difftime(a,b) not_here("difftime")
+#endif
+#endif
+#ifndef HAS_FPATHCONF
+#define fpathconf(f,n) 	(SysRetLong) not_here("fpathconf")
+#endif
+#ifndef HAS_MKTIME
+#define mktime(a) not_here("mktime")
+#endif
+#ifndef HAS_NICE
+#define nice(a) not_here("nice")
+#endif
+#ifndef HAS_PATHCONF
+#define pathconf(f,n) 	(SysRetLong) not_here("pathconf")
+#endif
+#ifndef HAS_SYSCONF
+#define sysconf(n) 	(SysRetLong) not_here("sysconf")
+#endif
+#ifndef HAS_READLINK
+#define readlink(a,b,c) not_here("readlink")
+#endif
+#ifndef HAS_SETPGID
+#define setpgid(a,b) not_here("setpgid")
+#endif
+#ifndef HAS_SETSID
+#define setsid() not_here("setsid")
+#endif
+#ifndef HAS_STRCOLL
+#define strcoll(s1,s2) not_here("strcoll")
+#endif
+#ifndef HAS_STRTOD
+#define strtod(s1,s2) not_here("strtod")
+#endif
+#ifndef HAS_STRTOL
+#define strtol(s1,s2,b) not_here("strtol")
+#endif
+#ifndef HAS_STRTOUL
+#define strtoul(s1,s2,b) not_here("strtoul")
+#endif
+#ifndef HAS_STRXFRM
+#define strxfrm(s1,s2,n) not_here("strxfrm")
+#endif
+#ifndef HAS_TCGETPGRP
+#define tcgetpgrp(a) not_here("tcgetpgrp")
+#endif
+#ifndef HAS_TCSETPGRP
+#define tcsetpgrp(a,b) not_here("tcsetpgrp")
+#endif
+#ifndef HAS_TIMES
+#define times(a) not_here("times")
+#endif
+#ifndef HAS_UNAME
+#define uname(a) not_here("uname")
+#endif
+#ifndef HAS_WAITPID
+#define waitpid(a,b,c) not_here("waitpid")
+#endif
+
+#ifndef HAS_MBLEN
+#ifndef mblen
+#define mblen(a,b) not_here("mblen")
+#endif
+#endif
+#ifndef HAS_MBSTOWCS
+#define mbstowcs(s, pwcs, n) not_here("mbstowcs")
+#endif
+#ifndef HAS_MBTOWC
+#define mbtowc(pwc, s, n) not_here("mbtowc")
+#endif
+#ifndef HAS_WCSTOMBS
+#define wcstombs(s, pwcs, n) not_here("wcstombs")
+#endif
+#ifndef HAS_WCTOMB
+#define wctomb(s, wchar) not_here("wcstombs")
+#endif
+#if !defined(HAS_MBLEN) && !defined(HAS_MBSTOWCS) && !defined(HAS_MBTOWC) && !defined(HAS_WCSTOMBS) && !defined(HAS_WCTOMB)
+/* If we don't have these functions, then we wouldn't have gotten a typedef
+   for wchar_t, the wide character type.  Defining wchar_t allows the
+   functions referencing it to compile.  Its actual type is then meaningless,
+   since without the above functions, all sections using it end up calling
+   not_here() and croak.  --Kaveh Ghazi (ghazi@noc.rutgers.edu) 9/18/94. */
+#ifndef wchar_t
+#define wchar_t char
+#endif
+#endif
+
+#ifndef HAS_LOCALECONV
+#define localeconv() not_here("localeconv")
+#endif
+
+#ifdef HAS_TZNAME
+#  ifndef WIN32
+extern char *tzname[];
+#  endif
+#else
+#if !defined(WIN32) || (defined(__MINGW32__) && !defined(tzname))
+char *tzname[] = { "" , "" };
+#endif
+#endif
+
+/* XXX struct tm on some systems (SunOS4/BSD) contains extra (non POSIX)
+ * fields for which we don't have Configure support yet:
+ *   char *tm_zone;   -- abbreviation of timezone name
+ *   long tm_gmtoff;  -- offset from GMT in seconds
+ * To workaround core dumps from the uninitialised tm_zone we get the
+ * system to give us a reasonable struct to copy.  This fix means that
+ * strftime uses the tm_zone and tm_gmtoff values returned by
+ * localtime(time()). That should give the desired result most of the
+ * time. But probably not always!
+ *
+ * This is a temporary workaround to be removed once Configure
+ * support is added and NETaa14816 is considered in full.
+ * It does not address tzname aspects of NETaa14816.
+ */
+#ifdef HAS_GNULIBC
+# ifndef STRUCT_TM_HASZONE
+#    define STRUCT_TM_HAS_ZONE
+# endif
+#endif
+
+#ifdef STRUCT_TM_HASZONE
+static void
+init_tm(ptm)		/* see mktime, strftime and asctime	*/
+    struct tm *ptm;
+{
+    Time_t now;
+    (void)time(&now);
+    Copy(localtime(&now), ptm, 1, struct tm);
+}
+
+#else
+# define init_tm(ptm)
+#endif
+
+
+#ifdef HAS_LONG_DOUBLE
+#  if LONG_DOUBLESIZE > DOUBLESIZE
+#    undef HAS_LONG_DOUBLE  /* XXX until we figure out how to use them */
+#  endif
+#endif
+
+#ifndef HAS_LONG_DOUBLE 
+#ifdef LDBL_MAX
+#undef LDBL_MAX
+#endif
+#ifdef LDBL_MIN
+#undef LDBL_MIN
+#endif
+#ifdef LDBL_EPSILON
+#undef LDBL_EPSILON
+#endif
+#endif
+
+static int
+not_here(char *s)
+{
+    croak("POSIX::%s not implemented on this architecture", s);
+    return -1;
+}
+
+static
+#ifdef HAS_LONG_DOUBLE
+long double
+#else
+double
+#endif
+constant(char *name, int arg)
+{
+    errno = 0;
+    switch (*name) {
+    case 'A':
+	if (strEQ(name, "ARG_MAX"))
+#ifdef ARG_MAX
+	    return ARG_MAX;
+#else
+	    goto not_there;
+#endif
+	break;
+    case 'B':
+	if (strEQ(name, "BUFSIZ"))
+#ifdef BUFSIZ
+	    return BUFSIZ;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "BRKINT"))
+#ifdef BRKINT
+	    return BRKINT;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "B9600"))
+#ifdef B9600
+	    return B9600;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "B19200"))
+#ifdef B19200
+	    return B19200;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "B38400"))
+#ifdef B38400
+	    return B38400;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "B0"))
+#ifdef B0
+	    return B0;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "B110"))
+#ifdef B110
+	    return B110;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "B1200"))
+#ifdef B1200
+	    return B1200;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "B134"))
+#ifdef B134
+	    return B134;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "B150"))
+#ifdef B150
+	    return B150;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "B1800"))
+#ifdef B1800
+	    return B1800;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "B200"))
+#ifdef B200
+	    return B200;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "B2400"))
+#ifdef B2400
+	    return B2400;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "B300"))
+#ifdef B300
+	    return B300;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "B4800"))
+#ifdef B4800
+	    return B4800;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "B50"))
+#ifdef B50
+	    return B50;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "B600"))
+#ifdef B600
+	    return B600;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "B75"))
+#ifdef B75
+	    return B75;
+#else
+	    goto not_there;
+#endif
+	break;
+    case 'C':
+	if (strEQ(name, "CHAR_BIT"))
+#ifdef CHAR_BIT
+	    return CHAR_BIT;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "CHAR_MAX"))
+#ifdef CHAR_MAX
+	    return CHAR_MAX;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "CHAR_MIN"))
+#ifdef CHAR_MIN
+	    return CHAR_MIN;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "CHILD_MAX"))
+#ifdef CHILD_MAX
+	    return CHILD_MAX;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "CLK_TCK"))
+#ifdef CLK_TCK
+	    return CLK_TCK;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "CLOCAL"))
+#ifdef CLOCAL
+	    return CLOCAL;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "CLOCKS_PER_SEC"))
+#ifdef CLOCKS_PER_SEC
+	    return CLOCKS_PER_SEC;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "CREAD"))
+#ifdef CREAD
+	    return CREAD;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "CS5"))
+#ifdef CS5
+	    return CS5;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "CS6"))
+#ifdef CS6
+	    return CS6;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "CS7"))
+#ifdef CS7
+	    return CS7;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "CS8"))
+#ifdef CS8
+	    return CS8;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "CSIZE"))
+#ifdef CSIZE
+	    return CSIZE;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "CSTOPB"))
+#ifdef CSTOPB
+	    return CSTOPB;
+#else
+	    goto not_there;
+#endif
+	break;
+    case 'D':
+	if (strEQ(name, "DBL_MAX"))
+#ifdef DBL_MAX
+	    return DBL_MAX;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "DBL_MIN"))
+#ifdef DBL_MIN
+	    return DBL_MIN;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "DBL_DIG"))
+#ifdef DBL_DIG
+	    return DBL_DIG;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "DBL_EPSILON"))
+#ifdef DBL_EPSILON
+	    return DBL_EPSILON;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "DBL_MANT_DIG"))
+#ifdef DBL_MANT_DIG
+	    return DBL_MANT_DIG;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "DBL_MAX_10_EXP"))
+#ifdef DBL_MAX_10_EXP
+	    return DBL_MAX_10_EXP;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "DBL_MAX_EXP"))
+#ifdef DBL_MAX_EXP
+	    return DBL_MAX_EXP;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "DBL_MIN_10_EXP"))
+#ifdef DBL_MIN_10_EXP
+	    return DBL_MIN_10_EXP;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "DBL_MIN_EXP"))
+#ifdef DBL_MIN_EXP
+	    return DBL_MIN_EXP;
+#else
+	    goto not_there;
+#endif
+	break;
+    case 'E':
+	switch (name[1]) {
+	case 'A':
+	    if (strEQ(name, "EACCES"))
+#ifdef EACCES
+		return EACCES;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "EADDRINUSE"))
+#ifdef EADDRINUSE
+		return EADDRINUSE;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "EADDRNOTAVAIL"))
+#ifdef EADDRNOTAVAIL
+		return EADDRNOTAVAIL;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "EAFNOSUPPORT"))
+#ifdef EAFNOSUPPORT
+		return EAFNOSUPPORT;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "EAGAIN"))
+#ifdef EAGAIN
+		return EAGAIN;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "EALREADY"))
+#ifdef EALREADY
+		return EALREADY;
+#else
+		goto not_there;
+#endif
+	    break;
+	case 'B':
+	    if (strEQ(name, "EBADF"))
+#ifdef EBADF
+		return EBADF;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "EBUSY"))
+#ifdef EBUSY
+		return EBUSY;
+#else
+		goto not_there;
+#endif
+	    break;
+	case 'C':
+	    if (strEQ(name, "ECHILD"))
+#ifdef ECHILD
+		return ECHILD;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "ECHO"))
+#ifdef ECHO
+		return ECHO;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "ECHOE"))
+#ifdef ECHOE
+		return ECHOE;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "ECHOK"))
+#ifdef ECHOK
+		return ECHOK;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "ECHONL"))
+#ifdef ECHONL
+		return ECHONL;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "ECONNABORTED"))
+#ifdef ECONNABORTED
+		return ECONNABORTED;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "ECONNREFUSED"))
+#ifdef ECONNREFUSED
+		return ECONNREFUSED;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "ECONNRESET"))
+#ifdef ECONNRESET
+		return ECONNRESET;
+#else
+		goto not_there;
+#endif
+	    break;
+	case 'D':
+	    if (strEQ(name, "EDEADLK"))
+#ifdef EDEADLK
+		return EDEADLK;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "EDESTADDRREQ"))
+#ifdef EDESTADDRREQ
+		return EDESTADDRREQ;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "EDOM"))
+#ifdef EDOM
+		return EDOM;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "EDQUOT"))
+#ifdef EDQUOT
+		return EDQUOT;
+#else
+		goto not_there;
+#endif
+	    break;
+	case 'E':
+	    if (strEQ(name, "EEXIST"))
+#ifdef EEXIST
+		return EEXIST;
+#else
+		goto not_there;
+#endif
+	    break;
+	case 'F':
+	    if (strEQ(name, "EFAULT"))
+#ifdef EFAULT
+		return EFAULT;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "EFBIG"))
+#ifdef EFBIG
+		return EFBIG;
+#else
+		goto not_there;
+#endif
+	    break;
+	case 'H':
+	    if (strEQ(name, "EHOSTDOWN"))
+#ifdef EHOSTDOWN
+		return EHOSTDOWN;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "EHOSTUNREACH"))
+#ifdef EHOSTUNREACH
+		return EHOSTUNREACH;
+#else
+		goto not_there;
+#endif
+    	    break;
+	case 'I':
+	    if (strEQ(name, "EINPROGRESS"))
+#ifdef EINPROGRESS
+		return EINPROGRESS;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "EINTR"))
+#ifdef EINTR
+		return EINTR;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "EINVAL"))
+#ifdef EINVAL
+		return EINVAL;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "EIO"))
+#ifdef EIO
+		return EIO;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "EISCONN"))
+#ifdef EISCONN
+		return EISCONN;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "EISDIR"))
+#ifdef EISDIR
+		return EISDIR;
+#else
+		goto not_there;
+#endif
+	    break;
+	case 'L':
+	    if (strEQ(name, "ELOOP"))
+#ifdef ELOOP
+		return ELOOP;
+#else
+		goto not_there;
+#endif
+	    break;
+	case 'M':
+	    if (strEQ(name, "EMFILE"))
+#ifdef EMFILE
+		return EMFILE;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "EMLINK"))
+#ifdef EMLINK
+		return EMLINK;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "EMSGSIZE"))
+#ifdef EMSGSIZE
+		return EMSGSIZE;
+#else
+		goto not_there;
+#endif
+	    break;
+	case 'N':
+	    if (strEQ(name, "ENETDOWN"))
+#ifdef ENETDOWN
+		return ENETDOWN;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "ENETRESET"))
+#ifdef ENETRESET
+		return ENETRESET;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "ENETUNREACH"))
+#ifdef ENETUNREACH
+		return ENETUNREACH;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "ENOBUFS"))
+#ifdef ENOBUFS
+		return ENOBUFS;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "ENOEXEC"))
+#ifdef ENOEXEC
+		return ENOEXEC;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "ENOMEM"))
+#ifdef ENOMEM
+		return ENOMEM;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "ENOPROTOOPT"))
+#ifdef ENOPROTOOPT
+		return ENOPROTOOPT;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "ENOSPC"))
+#ifdef ENOSPC
+		return ENOSPC;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "ENOTBLK"))
+#ifdef ENOTBLK
+		return ENOTBLK;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "ENOTCONN"))
+#ifdef ENOTCONN
+		return ENOTCONN;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "ENOTDIR"))
+#ifdef ENOTDIR
+		return ENOTDIR;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "ENOTEMPTY"))
+#ifdef ENOTEMPTY
+		return ENOTEMPTY;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "ENOTSOCK"))
+#ifdef ENOTSOCK
+		return ENOTSOCK;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "ENOTTY"))
+#ifdef ENOTTY
+		return ENOTTY;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "ENFILE"))
+#ifdef ENFILE
+		return ENFILE;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "ENODEV"))
+#ifdef ENODEV
+		return ENODEV;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "ENOENT"))
+#ifdef ENOENT
+		return ENOENT;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "ENOLCK"))
+#ifdef ENOLCK
+		return ENOLCK;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "ENOSYS"))
+#ifdef ENOSYS
+		return ENOSYS;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "ENXIO"))
+#ifdef ENXIO
+		return ENXIO;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "ENAMETOOLONG"))
+#ifdef ENAMETOOLONG
+		return ENAMETOOLONG;
+#else
+		goto not_there;
+#endif
+	    break;
+	case 'O':
+	    if (strEQ(name, "EOF"))
+#ifdef EOF
+		return EOF;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "EOPNOTSUPP"))
+#ifdef EOPNOTSUPP
+		return EOPNOTSUPP;
+#else
+		goto not_there;
+#endif
+	    break;
+	case 'P':
+	    if (strEQ(name, "EPERM"))
+#ifdef EPERM
+		return EPERM;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "EPFNOSUPPORT"))
+#ifdef EPFNOSUPPORT
+		return EPFNOSUPPORT;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "EPIPE"))
+#ifdef EPIPE
+		return EPIPE;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "EPROCLIM"))
+#ifdef EPROCLIM
+		return EPROCLIM;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "EPROTONOSUPPORT"))
+#ifdef EPROTONOSUPPORT
+		return EPROTONOSUPPORT;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "EPROTOTYPE"))
+#ifdef EPROTOTYPE
+		return EPROTOTYPE;
+#else
+		goto not_there;
+#endif
+	    break;
+	case 'R':
+	    if (strEQ(name, "ERANGE"))
+#ifdef ERANGE
+		return ERANGE;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "EREMOTE"))
+#ifdef EREMOTE
+		return EREMOTE;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "ERESTART"))
+#ifdef ERESTART
+		return ERESTART;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "EROFS"))
+#ifdef EROFS
+		return EROFS;
+#else
+		goto not_there;
+#endif
+	    break;
+	case 'S':
+	    if (strEQ(name, "ESHUTDOWN"))
+#ifdef ESHUTDOWN
+		return ESHUTDOWN;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "ESOCKTNOSUPPORT"))
+#ifdef ESOCKTNOSUPPORT
+		return ESOCKTNOSUPPORT;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "ESPIPE"))
+#ifdef ESPIPE
+		return ESPIPE;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "ESRCH"))
+#ifdef ESRCH
+		return ESRCH;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "ESTALE"))
+#ifdef ESTALE
+		return ESTALE;
+#else
+		goto not_there;
+#endif
+	    break;
+	case 'T':
+	    if (strEQ(name, "ETIMEDOUT"))
+#ifdef ETIMEDOUT
+		return ETIMEDOUT;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "ETOOMANYREFS"))
+#ifdef ETOOMANYREFS
+		return ETOOMANYREFS;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "ETXTBSY"))
+#ifdef ETXTBSY
+		return ETXTBSY;
+#else
+		goto not_there;
+#endif
+    	    break;
+	case 'U':
+	    if (strEQ(name, "EUSERS"))
+#ifdef EUSERS
+		return EUSERS;
+#else
+		goto not_there;
+#endif
+    	    break;
+    	case 'W':
+	    if (strEQ(name, "EWOULDBLOCK"))
+#ifdef EWOULDBLOCK
+		return EWOULDBLOCK;
+#else
+		goto not_there;
+#endif
+    	    break;
+	case 'X':
+	    if (strEQ(name, "EXIT_FAILURE"))
+#ifdef EXIT_FAILURE
+		return EXIT_FAILURE;
+#else
+		return 1;
+#endif
+	    if (strEQ(name, "EXIT_SUCCESS"))
+#ifdef EXIT_SUCCESS
+		return EXIT_SUCCESS;
+#else
+		return 0;
+#endif
+	    if (strEQ(name, "EXDEV"))
+#ifdef EXDEV
+		return EXDEV;
+#else
+		goto not_there;
+#endif
+	    break;
+	}
+	if (strEQ(name, "E2BIG"))
+#ifdef E2BIG
+	    return E2BIG;
+#else
+	    goto not_there;
+#endif
+	break;
+    case 'F':
+	if (strnEQ(name, "FLT_", 4)) {
+	    if (strEQ(name, "FLT_MAX"))
+#ifdef FLT_MAX
+		return FLT_MAX;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "FLT_MIN"))
+#ifdef FLT_MIN
+		return FLT_MIN;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "FLT_ROUNDS"))
+#ifdef FLT_ROUNDS
+		return FLT_ROUNDS;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "FLT_DIG"))
+#ifdef FLT_DIG
+		return FLT_DIG;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "FLT_EPSILON"))
+#ifdef FLT_EPSILON
+		return FLT_EPSILON;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "FLT_MANT_DIG"))
+#ifdef FLT_MANT_DIG
+		return FLT_MANT_DIG;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "FLT_MAX_10_EXP"))
+#ifdef FLT_MAX_10_EXP
+		return FLT_MAX_10_EXP;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "FLT_MAX_EXP"))
+#ifdef FLT_MAX_EXP
+		return FLT_MAX_EXP;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "FLT_MIN_10_EXP"))
+#ifdef FLT_MIN_10_EXP
+		return FLT_MIN_10_EXP;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "FLT_MIN_EXP"))
+#ifdef FLT_MIN_EXP
+		return FLT_MIN_EXP;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "FLT_RADIX"))
+#ifdef FLT_RADIX
+		return FLT_RADIX;
+#else
+		goto not_there;
+#endif
+	    break;
+	}
+	if (strnEQ(name, "F_", 2)) {
+	    if (strEQ(name, "F_DUPFD"))
+#ifdef F_DUPFD
+		return F_DUPFD;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "F_GETFD"))
+#ifdef F_GETFD
+		return F_GETFD;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "F_GETFL"))
+#ifdef F_GETFL
+		return F_GETFL;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "F_GETLK"))
+#ifdef F_GETLK
+		return F_GETLK;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "F_OK"))
+#ifdef F_OK
+		return F_OK;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "F_RDLCK"))
+#ifdef F_RDLCK
+		return F_RDLCK;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "F_SETFD"))
+#ifdef F_SETFD
+		return F_SETFD;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "F_SETFL"))
+#ifdef F_SETFL
+		return F_SETFL;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "F_SETLK"))
+#ifdef F_SETLK
+		return F_SETLK;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "F_SETLKW"))
+#ifdef F_SETLKW
+		return F_SETLKW;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "F_UNLCK"))
+#ifdef F_UNLCK
+		return F_UNLCK;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "F_WRLCK"))
+#ifdef F_WRLCK
+		return F_WRLCK;
+#else
+		goto not_there;
+#endif
+	    break;
+	}
+	if (strEQ(name, "FD_CLOEXEC"))
+#ifdef FD_CLOEXEC
+	    return FD_CLOEXEC;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "FILENAME_MAX"))
+#ifdef FILENAME_MAX
+	    return FILENAME_MAX;
+#else
+	    goto not_there;
+#endif
+	break;
+    case 'H':
+	if (strEQ(name, "HUGE_VAL"))
+#ifdef HUGE_VAL
+	    return HUGE_VAL;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "HUPCL"))
+#ifdef HUPCL
+	    return HUPCL;
+#else
+	    goto not_there;
+#endif
+	break;
+    case 'I':
+	if (strEQ(name, "INT_MAX"))
+#ifdef INT_MAX
+	    return INT_MAX;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "INT_MIN"))
+#ifdef INT_MIN
+	    return INT_MIN;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "ICANON"))
+#ifdef ICANON
+	    return ICANON;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "ICRNL"))
+#ifdef ICRNL
+	    return ICRNL;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "IEXTEN"))
+#ifdef IEXTEN
+	    return IEXTEN;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "IGNBRK"))
+#ifdef IGNBRK
+	    return IGNBRK;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "IGNCR"))
+#ifdef IGNCR
+	    return IGNCR;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "IGNPAR"))
+#ifdef IGNPAR
+	    return IGNPAR;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "INLCR"))
+#ifdef INLCR
+	    return INLCR;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "INPCK"))
+#ifdef INPCK
+	    return INPCK;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "ISIG"))
+#ifdef ISIG
+	    return ISIG;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "ISTRIP"))
+#ifdef ISTRIP
+	    return ISTRIP;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "IXOFF"))
+#ifdef IXOFF
+	    return IXOFF;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "IXON"))
+#ifdef IXON
+	    return IXON;
+#else
+	    goto not_there;
+#endif
+	break;
+    case 'L':
+	if (strnEQ(name, "LC_", 3)) {
+	    if (strEQ(name, "LC_ALL"))
+#ifdef LC_ALL
+		return LC_ALL;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "LC_COLLATE"))
+#ifdef LC_COLLATE
+		return LC_COLLATE;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "LC_CTYPE"))
+#ifdef LC_CTYPE
+		return LC_CTYPE;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "LC_MONETARY"))
+#ifdef LC_MONETARY
+		return LC_MONETARY;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "LC_NUMERIC"))
+#ifdef LC_NUMERIC
+		return LC_NUMERIC;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "LC_TIME"))
+#ifdef LC_TIME
+		return LC_TIME;
+#else
+		goto not_there;
+#endif
+	    break;
+	}
+	if (strnEQ(name, "LDBL_", 5)) {
+	    if (strEQ(name, "LDBL_MAX"))
+#ifdef LDBL_MAX
+		return LDBL_MAX;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "LDBL_MIN"))
+#ifdef LDBL_MIN
+		return LDBL_MIN;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "LDBL_DIG"))
+#ifdef LDBL_DIG
+		return LDBL_DIG;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "LDBL_EPSILON"))
+#ifdef LDBL_EPSILON
+		return LDBL_EPSILON;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "LDBL_MANT_DIG"))
+#ifdef LDBL_MANT_DIG
+		return LDBL_MANT_DIG;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "LDBL_MAX_10_EXP"))
+#ifdef LDBL_MAX_10_EXP
+		return LDBL_MAX_10_EXP;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "LDBL_MAX_EXP"))
+#ifdef LDBL_MAX_EXP
+		return LDBL_MAX_EXP;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "LDBL_MIN_10_EXP"))
+#ifdef LDBL_MIN_10_EXP
+		return LDBL_MIN_10_EXP;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "LDBL_MIN_EXP"))
+#ifdef LDBL_MIN_EXP
+		return LDBL_MIN_EXP;
+#else
+		goto not_there;
+#endif
+	    break;
+	}
+	if (strnEQ(name, "L_", 2)) {
+	    if (strEQ(name, "L_ctermid"))
+#ifdef L_ctermid
+		return L_ctermid;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "L_cuserid"))
+#ifdef L_cuserid
+		return L_cuserid;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "L_tmpname"))
+#ifdef L_tmpname
+		return L_tmpname;
+#else
+		goto not_there;
+#endif
+	    break;
+	}
+	if (strEQ(name, "LONG_MAX"))
+#ifdef LONG_MAX
+	    return LONG_MAX;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "LONG_MIN"))
+#ifdef LONG_MIN
+	    return LONG_MIN;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "LINK_MAX"))
+#ifdef LINK_MAX
+	    return LINK_MAX;
+#else
+	    goto not_there;
+#endif
+	break;
+    case 'M':
+	if (strEQ(name, "MAX_CANON"))
+#ifdef MAX_CANON
+	    return MAX_CANON;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "MAX_INPUT"))
+#ifdef MAX_INPUT
+	    return MAX_INPUT;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "MB_CUR_MAX"))
+#ifdef MB_CUR_MAX
+	    return MB_CUR_MAX;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "MB_LEN_MAX"))
+#ifdef MB_LEN_MAX
+	    return MB_LEN_MAX;
+#else
+	    goto not_there;
+#endif
+	break;
+    case 'N':
+	if (strEQ(name, "NULL")) return 0;
+	if (strEQ(name, "NAME_MAX"))
+#ifdef NAME_MAX
+	    return NAME_MAX;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "NCCS"))
+#ifdef NCCS
+	    return NCCS;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "NGROUPS_MAX"))
+#ifdef NGROUPS_MAX
+	    return NGROUPS_MAX;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "NOFLSH"))
+#ifdef NOFLSH
+	    return NOFLSH;
+#else
+	    goto not_there;
+#endif
+	break;
+    case 'O':
+	if (strnEQ(name, "O_", 2)) {
+	    if (strEQ(name, "O_APPEND"))
+#ifdef O_APPEND
+		return O_APPEND;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "O_CREAT"))
+#ifdef O_CREAT
+		return O_CREAT;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "O_TRUNC"))
+#ifdef O_TRUNC
+		return O_TRUNC;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "O_RDONLY"))
+#ifdef O_RDONLY
+		return O_RDONLY;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "O_RDWR"))
+#ifdef O_RDWR
+		return O_RDWR;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "O_WRONLY"))
+#ifdef O_WRONLY
+		return O_WRONLY;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "O_EXCL"))
+#ifdef O_EXCL
+		return O_EXCL;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "O_NOCTTY"))
+#ifdef O_NOCTTY
+		return O_NOCTTY;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "O_NONBLOCK"))
+#ifdef O_NONBLOCK
+		return O_NONBLOCK;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "O_ACCMODE"))
+#ifdef O_ACCMODE
+		return O_ACCMODE;
+#else
+		goto not_there;
+#endif
+	    break;
+	}
+	if (strEQ(name, "OPEN_MAX"))
+#ifdef OPEN_MAX
+	    return OPEN_MAX;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "OPOST"))
+#ifdef OPOST
+	    return OPOST;
+#else
+	    goto not_there;
+#endif
+	break;
+    case 'P':
+	if (strEQ(name, "PATH_MAX"))
+#ifdef PATH_MAX
+	    return PATH_MAX;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "PARENB"))
+#ifdef PARENB
+	    return PARENB;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "PARMRK"))
+#ifdef PARMRK
+	    return PARMRK;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "PARODD"))
+#ifdef PARODD
+	    return PARODD;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "PIPE_BUF"))
+#ifdef PIPE_BUF
+	    return PIPE_BUF;
+#else
+	    goto not_there;
+#endif
+	break;
+    case 'R':
+	if (strEQ(name, "RAND_MAX"))
+#ifdef RAND_MAX
+	    return RAND_MAX;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "R_OK"))
+#ifdef R_OK
+	    return R_OK;
+#else
+	    goto not_there;
+#endif
+	break;
+    case 'S':
+	if (strnEQ(name, "SIG", 3)) {
+	    if (name[3] == '_') {
+		if (strEQ(name, "SIG_BLOCK"))
+#ifdef SIG_BLOCK
+		    return SIG_BLOCK;
+#else
+		    goto not_there;
+#endif
+#ifdef SIG_DFL
+		if (strEQ(name, "SIG_DFL")) return (IV)SIG_DFL;
+#endif
+#ifdef SIG_ERR
+		if (strEQ(name, "SIG_ERR")) return (IV)SIG_ERR;
+#endif
+#ifdef SIG_IGN
+		if (strEQ(name, "SIG_IGN")) return (IV)SIG_IGN;
+#endif
+		if (strEQ(name, "SIG_SETMASK"))
+#ifdef SIG_SETMASK
+		    return SIG_SETMASK;
+#else
+		    goto not_there;
+#endif
+		if (strEQ(name, "SIG_UNBLOCK"))
+#ifdef SIG_UNBLOCK
+		    return SIG_UNBLOCK;
+#else
+		    goto not_there;
+#endif
+		break;
+	    }
+	    if (strEQ(name, "SIGABRT"))
+#ifdef SIGABRT
+		return SIGABRT;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "SIGALRM"))
+#ifdef SIGALRM
+		return SIGALRM;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "SIGCHLD"))
+#ifdef SIGCHLD
+		return SIGCHLD;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "SIGCONT"))
+#ifdef SIGCONT
+		return SIGCONT;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "SIGFPE"))
+#ifdef SIGFPE
+		return SIGFPE;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "SIGHUP"))
+#ifdef SIGHUP
+		return SIGHUP;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "SIGILL"))
+#ifdef SIGILL
+		return SIGILL;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "SIGINT"))
+#ifdef SIGINT
+		return SIGINT;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "SIGKILL"))
+#ifdef SIGKILL
+		return SIGKILL;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "SIGPIPE"))
+#ifdef SIGPIPE
+		return SIGPIPE;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "SIGQUIT"))
+#ifdef SIGQUIT
+		return SIGQUIT;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "SIGSEGV"))
+#ifdef SIGSEGV
+		return SIGSEGV;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "SIGSTOP"))
+#ifdef SIGSTOP
+		return SIGSTOP;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "SIGTERM"))
+#ifdef SIGTERM
+		return SIGTERM;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "SIGTSTP"))
+#ifdef SIGTSTP
+		return SIGTSTP;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "SIGTTIN"))
+#ifdef SIGTTIN
+		return SIGTTIN;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "SIGTTOU"))
+#ifdef SIGTTOU
+		return SIGTTOU;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "SIGUSR1"))
+#ifdef SIGUSR1
+		return SIGUSR1;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "SIGUSR2"))
+#ifdef SIGUSR2
+		return SIGUSR2;
+#else
+		goto not_there;
+#endif
+	    break;
+	}
+	if (name[1] == '_') {
+	    if (strEQ(name, "S_ISGID"))
+#ifdef S_ISGID
+		return S_ISGID;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "S_ISUID"))
+#ifdef S_ISUID
+		return S_ISUID;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "S_IRGRP"))
+#ifdef S_IRGRP
+		return S_IRGRP;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "S_IROTH"))
+#ifdef S_IROTH
+		return S_IROTH;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "S_IRUSR"))
+#ifdef S_IRUSR
+		return S_IRUSR;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "S_IRWXG"))
+#ifdef S_IRWXG
+		return S_IRWXG;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "S_IRWXO"))
+#ifdef S_IRWXO
+		return S_IRWXO;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "S_IRWXU"))
+#ifdef S_IRWXU
+		return S_IRWXU;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "S_IWGRP"))
+#ifdef S_IWGRP
+		return S_IWGRP;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "S_IWOTH"))
+#ifdef S_IWOTH
+		return S_IWOTH;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "S_IWUSR"))
+#ifdef S_IWUSR
+		return S_IWUSR;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "S_IXGRP"))
+#ifdef S_IXGRP
+		return S_IXGRP;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "S_IXOTH"))
+#ifdef S_IXOTH
+		return S_IXOTH;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "S_IXUSR"))
+#ifdef S_IXUSR
+		return S_IXUSR;
+#else
+		goto not_there;
+#endif
+	    errno = EAGAIN;		/* the following aren't constants */
+#ifdef S_ISBLK
+	    if (strEQ(name, "S_ISBLK")) return S_ISBLK(arg);
+#endif
+#ifdef S_ISCHR
+	    if (strEQ(name, "S_ISCHR")) return S_ISCHR(arg);
+#endif
+#ifdef S_ISDIR
+	    if (strEQ(name, "S_ISDIR")) return S_ISDIR(arg);
+#endif
+#ifdef S_ISFIFO
+	    if (strEQ(name, "S_ISFIFO")) return S_ISFIFO(arg);
+#endif
+#ifdef S_ISREG
+	    if (strEQ(name, "S_ISREG")) return S_ISREG(arg);
+#endif
+	    break;
+	}
+	if (strEQ(name, "SEEK_CUR"))
+#ifdef SEEK_CUR
+	    return SEEK_CUR;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "SEEK_END"))
+#ifdef SEEK_END
+	    return SEEK_END;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "SEEK_SET"))
+#ifdef SEEK_SET
+	    return SEEK_SET;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "STREAM_MAX"))
+#ifdef STREAM_MAX
+	    return STREAM_MAX;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "SHRT_MAX"))
+#ifdef SHRT_MAX
+	    return SHRT_MAX;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "SHRT_MIN"))
+#ifdef SHRT_MIN
+	    return SHRT_MIN;
+#else
+	    goto not_there;
+#endif
+	if (strnEQ(name, "SA_", 3)) {
+	    if (strEQ(name, "SA_NOCLDSTOP"))
+#ifdef SA_NOCLDSTOP
+		return SA_NOCLDSTOP;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "SA_NOCLDWAIT"))
+#ifdef SA_NOCLDWAIT
+		return SA_NOCLDWAIT;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "SA_NODEFER"))
+#ifdef SA_NODEFER
+		return SA_NODEFER;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "SA_ONSTACK"))
+#ifdef SA_ONSTACK
+		return SA_ONSTACK;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "SA_RESETHAND"))
+#ifdef SA_RESETHAND
+		return SA_RESETHAND;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "SA_RESTART"))
+#ifdef SA_RESTART
+		return SA_RESTART;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "SA_SIGINFO"))
+#ifdef SA_SIGINFO
+		return SA_SIGINFO;
+#else
+		goto not_there;
+#endif
+	    break;
+	}
+	if (strEQ(name, "SCHAR_MAX"))
+#ifdef SCHAR_MAX
+	    return SCHAR_MAX;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "SCHAR_MIN"))
+#ifdef SCHAR_MIN
+	    return SCHAR_MIN;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "SSIZE_MAX"))
+#ifdef SSIZE_MAX
+	    return SSIZE_MAX;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "STDIN_FILENO"))
+#ifdef STDIN_FILENO
+	    return STDIN_FILENO;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "STDOUT_FILENO"))
+#ifdef STDOUT_FILENO
+	    return STDOUT_FILENO;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "STRERR_FILENO"))
+#ifdef STRERR_FILENO
+	    return STRERR_FILENO;
+#else
+	    goto not_there;
+#endif
+	break;
+    case 'T':
+	if (strEQ(name, "TCIFLUSH"))
+#ifdef TCIFLUSH
+	    return TCIFLUSH;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "TCIOFF"))
+#ifdef TCIOFF
+	    return TCIOFF;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "TCIOFLUSH"))
+#ifdef TCIOFLUSH
+	    return TCIOFLUSH;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "TCION"))
+#ifdef TCION
+	    return TCION;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "TCOFLUSH"))
+#ifdef TCOFLUSH
+	    return TCOFLUSH;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "TCOOFF"))
+#ifdef TCOOFF
+	    return TCOOFF;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "TCOON"))
+#ifdef TCOON
+	    return TCOON;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "TCSADRAIN"))
+#ifdef TCSADRAIN
+	    return TCSADRAIN;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "TCSAFLUSH"))
+#ifdef TCSAFLUSH
+	    return TCSAFLUSH;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "TCSANOW"))
+#ifdef TCSANOW
+	    return TCSANOW;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "TMP_MAX"))
+#ifdef TMP_MAX
+	    return TMP_MAX;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "TOSTOP"))
+#ifdef TOSTOP
+	    return TOSTOP;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "TZNAME_MAX"))
+#ifdef TZNAME_MAX
+	    return TZNAME_MAX;
+#else
+	    goto not_there;
+#endif
+	break;
+    case 'U':
+	if (strEQ(name, "UCHAR_MAX"))
+#ifdef UCHAR_MAX
+	    return UCHAR_MAX;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "UINT_MAX"))
+#ifdef UINT_MAX
+	    return UINT_MAX;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "ULONG_MAX"))
+#ifdef ULONG_MAX
+	    return ULONG_MAX;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "USHRT_MAX"))
+#ifdef USHRT_MAX
+	    return USHRT_MAX;
+#else
+	    goto not_there;
+#endif
+	break;
+    case 'V':
+	if (strEQ(name, "VEOF"))
+#ifdef VEOF
+	    return VEOF;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "VEOL"))
+#ifdef VEOL
+	    return VEOL;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "VERASE"))
+#ifdef VERASE
+	    return VERASE;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "VINTR"))
+#ifdef VINTR
+	    return VINTR;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "VKILL"))
+#ifdef VKILL
+	    return VKILL;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "VMIN"))
+#ifdef VMIN
+	    return VMIN;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "VQUIT"))
+#ifdef VQUIT
+	    return VQUIT;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "VSTART"))
+#ifdef VSTART
+	    return VSTART;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "VSTOP"))
+#ifdef VSTOP
+	    return VSTOP;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "VSUSP"))
+#ifdef VSUSP
+	    return VSUSP;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "VTIME"))
+#ifdef VTIME
+	    return VTIME;
+#else
+	    goto not_there;
+#endif
+	break;
+    case 'W':
+	if (strEQ(name, "W_OK"))
+#ifdef W_OK
+	    return W_OK;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "WNOHANG"))
+#ifdef WNOHANG
+	    return WNOHANG;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "WUNTRACED"))
+#ifdef WUNTRACED
+	    return WUNTRACED;
+#else
+	    goto not_there;
+#endif
+	errno = EAGAIN;		/* the following aren't constants */
+#ifdef WEXITSTATUS
+	if (strEQ(name, "WEXITSTATUS")) return WEXITSTATUS(arg);
+#endif
+#ifdef WIFEXITED
+	if (strEQ(name, "WIFEXITED")) return WIFEXITED(arg);
+#endif
+#ifdef WIFSIGNALED
+	if (strEQ(name, "WIFSIGNALED")) return WIFSIGNALED(arg);
+#endif
+#ifdef WIFSTOPPED
+	if (strEQ(name, "WIFSTOPPED")) return WIFSTOPPED(arg);
+#endif
+#ifdef WSTOPSIG
+	if (strEQ(name, "WSTOPSIG")) return WSTOPSIG(arg);
+#endif
+#ifdef WTERMSIG
+	if (strEQ(name, "WTERMSIG")) return WTERMSIG(arg);
+#endif
+	break;
+    case 'X':
+	if (strEQ(name, "X_OK"))
+#ifdef X_OK
+	    return X_OK;
+#else
+	    goto not_there;
+#endif
+	break;
+    case '_':
+	if (strnEQ(name, "_PC_", 4)) {
+	    if (strEQ(name, "_PC_CHOWN_RESTRICTED"))
+#if defined(_PC_CHOWN_RESTRICTED) || HINT_SC_EXIST
+		return _PC_CHOWN_RESTRICTED;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "_PC_LINK_MAX"))
+#if defined(_PC_LINK_MAX) || HINT_SC_EXIST
+		return _PC_LINK_MAX;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "_PC_MAX_CANON"))
+#if defined(_PC_MAX_CANON) || HINT_SC_EXIST
+		return _PC_MAX_CANON;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "_PC_MAX_INPUT"))
+#if defined(_PC_MAX_INPUT) || HINT_SC_EXIST
+		return _PC_MAX_INPUT;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "_PC_NAME_MAX"))
+#if defined(_PC_NAME_MAX) || HINT_SC_EXIST
+		return _PC_NAME_MAX;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "_PC_NO_TRUNC"))
+#if defined(_PC_NO_TRUNC) || HINT_SC_EXIST
+		return _PC_NO_TRUNC;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "_PC_PATH_MAX"))
+#if defined(_PC_PATH_MAX) || HINT_SC_EXIST
+		return _PC_PATH_MAX;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "_PC_PIPE_BUF"))
+#if defined(_PC_PIPE_BUF) || HINT_SC_EXIST
+		return _PC_PIPE_BUF;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "_PC_VDISABLE"))
+#if defined(_PC_VDISABLE) || HINT_SC_EXIST
+		return _PC_VDISABLE;
+#else
+		goto not_there;
+#endif
+	    break;
+	}
+	if (strnEQ(name, "_POSIX_", 7)) {
+	    if (strEQ(name, "_POSIX_ARG_MAX"))
+#ifdef _POSIX_ARG_MAX
+		return _POSIX_ARG_MAX;
+#else
+		return 0;
+#endif
+	    if (strEQ(name, "_POSIX_CHILD_MAX"))
+#ifdef _POSIX_CHILD_MAX
+		return _POSIX_CHILD_MAX;
+#else
+		return 0;
+#endif
+	    if (strEQ(name, "_POSIX_CHOWN_RESTRICTED"))
+#ifdef _POSIX_CHOWN_RESTRICTED
+		return _POSIX_CHOWN_RESTRICTED;
+#else
+		return 0;
+#endif
+	    if (strEQ(name, "_POSIX_JOB_CONTROL"))
+#ifdef _POSIX_JOB_CONTROL
+		return _POSIX_JOB_CONTROL;
+#else
+		return 0;
+#endif
+	    if (strEQ(name, "_POSIX_LINK_MAX"))
+#ifdef _POSIX_LINK_MAX
+		return _POSIX_LINK_MAX;
+#else
+		return 0;
+#endif
+	    if (strEQ(name, "_POSIX_MAX_CANON"))
+#ifdef _POSIX_MAX_CANON
+		return _POSIX_MAX_CANON;
+#else
+		return 0;
+#endif
+	    if (strEQ(name, "_POSIX_MAX_INPUT"))
+#ifdef _POSIX_MAX_INPUT
+		return _POSIX_MAX_INPUT;
+#else
+		return 0;
+#endif
+	    if (strEQ(name, "_POSIX_NAME_MAX"))
+#ifdef _POSIX_NAME_MAX
+		return _POSIX_NAME_MAX;
+#else
+		return 0;
+#endif
+	    if (strEQ(name, "_POSIX_NGROUPS_MAX"))
+#ifdef _POSIX_NGROUPS_MAX
+		return _POSIX_NGROUPS_MAX;
+#else
+		return 0;
+#endif
+	    if (strEQ(name, "_POSIX_NO_TRUNC"))
+#ifdef _POSIX_NO_TRUNC
+		return _POSIX_NO_TRUNC;
+#else
+		return 0;
+#endif
+	    if (strEQ(name, "_POSIX_OPEN_MAX"))
+#ifdef _POSIX_OPEN_MAX
+		return _POSIX_OPEN_MAX;
+#else
+		return 0;
+#endif
+	    if (strEQ(name, "_POSIX_PATH_MAX"))
+#ifdef _POSIX_PATH_MAX
+		return _POSIX_PATH_MAX;
+#else
+		return 0;
+#endif
+	    if (strEQ(name, "_POSIX_PIPE_BUF"))
+#ifdef _POSIX_PIPE_BUF
+		return _POSIX_PIPE_BUF;
+#else
+		return 0;
+#endif
+	    if (strEQ(name, "_POSIX_SAVED_IDS"))
+#ifdef _POSIX_SAVED_IDS
+		return _POSIX_SAVED_IDS;
+#else
+		return 0;
+#endif
+	    if (strEQ(name, "_POSIX_SSIZE_MAX"))
+#ifdef _POSIX_SSIZE_MAX
+		return _POSIX_SSIZE_MAX;
+#else
+		return 0;
+#endif
+	    if (strEQ(name, "_POSIX_STREAM_MAX"))
+#ifdef _POSIX_STREAM_MAX
+		return _POSIX_STREAM_MAX;
+#else
+		return 0;
+#endif
+	    if (strEQ(name, "_POSIX_TZNAME_MAX"))
+#ifdef _POSIX_TZNAME_MAX
+		return _POSIX_TZNAME_MAX;
+#else
+		return 0;
+#endif
+	    if (strEQ(name, "_POSIX_VDISABLE"))
+#ifdef _POSIX_VDISABLE
+		return _POSIX_VDISABLE;
+#else
+		return 0;
+#endif
+	    if (strEQ(name, "_POSIX_VERSION"))
+#ifdef _POSIX_VERSION
+		return _POSIX_VERSION;
+#else
+		return 0;
+#endif
+	    break;
+	}
+	if (strnEQ(name, "_SC_", 4)) {
+	    if (strEQ(name, "_SC_ARG_MAX"))
+#if defined(_SC_ARG_MAX) || HINT_SC_EXIST
+		return _SC_ARG_MAX;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "_SC_CHILD_MAX"))
+#if defined(_SC_CHILD_MAX) || HINT_SC_EXIST
+		return _SC_CHILD_MAX;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "_SC_CLK_TCK"))
+#if defined(_SC_CLK_TCK) || HINT_SC_EXIST
+		return _SC_CLK_TCK;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "_SC_JOB_CONTROL"))
+#if defined(_SC_JOB_CONTROL) || HINT_SC_EXIST
+		return _SC_JOB_CONTROL;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "_SC_NGROUPS_MAX"))
+#if defined(_SC_NGROUPS_MAX) || HINT_SC_EXIST
+		return _SC_NGROUPS_MAX;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "_SC_OPEN_MAX"))
+#if defined(_SC_OPEN_MAX) || HINT_SC_EXIST
+		return _SC_OPEN_MAX;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "_SC_SAVED_IDS"))
+#if defined(_SC_SAVED_IDS) || HINT_SC_EXIST
+		return _SC_SAVED_IDS;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "_SC_STREAM_MAX"))
+#if defined(_SC_STREAM_MAX) || HINT_SC_EXIST
+		return _SC_STREAM_MAX;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "_SC_TZNAME_MAX"))
+#if defined(_SC_TZNAME_MAX) || HINT_SC_EXIST
+		return _SC_TZNAME_MAX;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "_SC_VERSION"))
+#if defined(_SC_VERSION) || HINT_SC_EXIST
+		return _SC_VERSION;
+#else
+		goto not_there;
+#endif
+	    break;
+	}
+    }
+    errno = EINVAL;
+    return 0;
+
+not_there:
+    errno = ENOENT;
+    return 0;
+}
+
+MODULE = SigSet		PACKAGE = POSIX::SigSet		PREFIX = sig
+
+POSIX::SigSet
+new(packname = "POSIX::SigSet", ...)
+    char *		packname
+    CODE:
+	{
+	    int i;
+	    RETVAL = (sigset_t*)safemalloc(sizeof(sigset_t));
+	    sigemptyset(RETVAL);
+	    for (i = 1; i < items; i++)
+		sigaddset(RETVAL, SvIV(ST(i)));
+	}
+    OUTPUT:
+	RETVAL
+
+void
+DESTROY(sigset)
+	POSIX::SigSet	sigset
+    CODE:
+	safefree((char *)sigset);
+
+SysRet
+sigaddset(sigset, sig)
+	POSIX::SigSet	sigset
+	int		sig
+
+SysRet
+sigdelset(sigset, sig)
+	POSIX::SigSet	sigset
+	int		sig
+
+SysRet
+sigemptyset(sigset)
+	POSIX::SigSet	sigset
+
+SysRet
+sigfillset(sigset)
+	POSIX::SigSet	sigset
+
+int
+sigismember(sigset, sig)
+	POSIX::SigSet	sigset
+	int		sig
+
+
+MODULE = Termios	PACKAGE = POSIX::Termios	PREFIX = cf
+
+POSIX::Termios
+new(packname = "POSIX::Termios", ...)
+    char *		packname
+    CODE:
+	{
+#ifdef I_TERMIOS
+	    RETVAL = (struct termios*)safemalloc(sizeof(struct termios));
+#else
+	    not_here("termios");
+        RETVAL = 0;
+#endif
+	}
+    OUTPUT:
+	RETVAL
+
+void
+DESTROY(termios_ref)
+	POSIX::Termios	termios_ref
+    CODE:
+#ifdef I_TERMIOS
+	safefree((char *)termios_ref);
+#else
+	    not_here("termios");
+#endif
+
+SysRet
+getattr(termios_ref, fd = 0)
+	POSIX::Termios	termios_ref
+	int		fd
+    CODE:
+	RETVAL = tcgetattr(fd, termios_ref);
+    OUTPUT:
+	RETVAL
+
+SysRet
+setattr(termios_ref, fd = 0, optional_actions = 0)
+	POSIX::Termios	termios_ref
+	int		fd
+	int		optional_actions
+    CODE:
+	RETVAL = tcsetattr(fd, optional_actions, termios_ref);
+    OUTPUT:
+	RETVAL
+
+speed_t
+cfgetispeed(termios_ref)
+	POSIX::Termios	termios_ref
+
+speed_t
+cfgetospeed(termios_ref)
+	POSIX::Termios	termios_ref
+
+tcflag_t
+getiflag(termios_ref)
+	POSIX::Termios	termios_ref
+    CODE:
+#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
+	RETVAL = termios_ref->c_iflag;
+#else
+     not_here("getiflag");
+     RETVAL = 0;
+#endif
+    OUTPUT:
+	RETVAL
+
+tcflag_t
+getoflag(termios_ref)
+	POSIX::Termios	termios_ref
+    CODE:
+#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
+	RETVAL = termios_ref->c_oflag;
+#else
+     not_here("getoflag");
+     RETVAL = 0;
+#endif
+    OUTPUT:
+	RETVAL
+
+tcflag_t
+getcflag(termios_ref)
+	POSIX::Termios	termios_ref
+    CODE:
+#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
+	RETVAL = termios_ref->c_cflag;
+#else
+     not_here("getcflag");
+     RETVAL = 0;
+#endif
+    OUTPUT:
+	RETVAL
+
+tcflag_t
+getlflag(termios_ref)
+	POSIX::Termios	termios_ref
+    CODE:
+#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
+	RETVAL = termios_ref->c_lflag;
+#else
+     not_here("getlflag");
+     RETVAL = 0;
+#endif
+    OUTPUT:
+	RETVAL
+
+cc_t
+getcc(termios_ref, ccix)
+	POSIX::Termios	termios_ref
+	int		ccix
+    CODE:
+#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
+	if (ccix >= NCCS)
+	    croak("Bad getcc subscript");
+	RETVAL = termios_ref->c_cc[ccix];
+#else
+     not_here("getcc");
+     RETVAL = 0;
+#endif
+    OUTPUT:
+	RETVAL
+
+SysRet
+cfsetispeed(termios_ref, speed)
+	POSIX::Termios	termios_ref
+	speed_t		speed
+
+SysRet
+cfsetospeed(termios_ref, speed)
+	POSIX::Termios	termios_ref
+	speed_t		speed
+
+void
+setiflag(termios_ref, iflag)
+	POSIX::Termios	termios_ref
+	tcflag_t	iflag
+    CODE:
+#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
+	termios_ref->c_iflag = iflag;
+#else
+	    not_here("setiflag");
+#endif
+
+void
+setoflag(termios_ref, oflag)
+	POSIX::Termios	termios_ref
+	tcflag_t	oflag
+    CODE:
+#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
+	termios_ref->c_oflag = oflag;
+#else
+	    not_here("setoflag");
+#endif
+
+void
+setcflag(termios_ref, cflag)
+	POSIX::Termios	termios_ref
+	tcflag_t	cflag
+    CODE:
+#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
+	termios_ref->c_cflag = cflag;
+#else
+	    not_here("setcflag");
+#endif
+
+void
+setlflag(termios_ref, lflag)
+	POSIX::Termios	termios_ref
+	tcflag_t	lflag
+    CODE:
+#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
+	termios_ref->c_lflag = lflag;
+#else
+	    not_here("setlflag");
+#endif
+
+void
+setcc(termios_ref, ccix, cc)
+	POSIX::Termios	termios_ref
+	int		ccix
+	cc_t		cc
+    CODE:
+#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
+	if (ccix >= NCCS)
+	    croak("Bad setcc subscript");
+	termios_ref->c_cc[ccix] = cc;
+#else
+	    not_here("setcc");
+#endif
+
+
+MODULE = POSIX		PACKAGE = POSIX
+
+double
+constant(name,arg)
+	char *		name
+	int		arg
+
+int
+isalnum(charstring)
+	unsigned char *	charstring
+    CODE:
+	unsigned char *s = charstring;
+	unsigned char *e = s + PL_na;	/* "PL_na" set by typemap side effect */
+	for (RETVAL = 1; RETVAL && s < e; s++)
+	    if (!isalnum(*s))
+		RETVAL = 0;
+    OUTPUT:
+	RETVAL
+
+int
+isalpha(charstring)
+	unsigned char *	charstring
+    CODE:
+	unsigned char *s = charstring;
+	unsigned char *e = s + PL_na;	/* "PL_na" set by typemap side effect */
+	for (RETVAL = 1; RETVAL && s < e; s++)
+	    if (!isalpha(*s))
+		RETVAL = 0;
+    OUTPUT:
+	RETVAL
+
+int
+iscntrl(charstring)
+	unsigned char *	charstring
+    CODE:
+	unsigned char *s = charstring;
+	unsigned char *e = s + PL_na;	/* "PL_na" set by typemap side effect */
+	for (RETVAL = 1; RETVAL && s < e; s++)
+	    if (!iscntrl(*s))
+		RETVAL = 0;
+    OUTPUT:
+	RETVAL
+
+int
+isdigit(charstring)
+	unsigned char *	charstring
+    CODE:
+	unsigned char *s = charstring;
+	unsigned char *e = s + PL_na;	/* "PL_na" set by typemap side effect */
+	for (RETVAL = 1; RETVAL && s < e; s++)
+	    if (!isdigit(*s))
+		RETVAL = 0;
+    OUTPUT:
+	RETVAL
+
+int
+isgraph(charstring)
+	unsigned char *	charstring
+    CODE:
+	unsigned char *s = charstring;
+	unsigned char *e = s + PL_na;	/* "PL_na" set by typemap side effect */
+	for (RETVAL = 1; RETVAL && s < e; s++)
+	    if (!isgraph(*s))
+		RETVAL = 0;
+    OUTPUT:
+	RETVAL
+
+int
+islower(charstring)
+	unsigned char *	charstring
+    CODE:
+	unsigned char *s = charstring;
+	unsigned char *e = s + PL_na;	/* "PL_na" set by typemap side effect */
+	for (RETVAL = 1; RETVAL && s < e; s++)
+	    if (!islower(*s))
+		RETVAL = 0;
+    OUTPUT:
+	RETVAL
+
+int
+isprint(charstring)
+	unsigned char *	charstring
+    CODE:
+	unsigned char *s = charstring;
+	unsigned char *e = s + PL_na;	/* "PL_na" set by typemap side effect */
+	for (RETVAL = 1; RETVAL && s < e; s++)
+	    if (!isprint(*s))
+		RETVAL = 0;
+    OUTPUT:
+	RETVAL
+
+int
+ispunct(charstring)
+	unsigned char *	charstring
+    CODE:
+	unsigned char *s = charstring;
+	unsigned char *e = s + PL_na;	/* "PL_na" set by typemap side effect */
+	for (RETVAL = 1; RETVAL && s < e; s++)
+	    if (!ispunct(*s))
+		RETVAL = 0;
+    OUTPUT:
+	RETVAL
+
+int
+isspace(charstring)
+	unsigned char *	charstring
+    CODE:
+	unsigned char *s = charstring;
+	unsigned char *e = s + PL_na;	/* "PL_na" set by typemap side effect */
+	for (RETVAL = 1; RETVAL && s < e; s++)
+	    if (!isspace(*s))
+		RETVAL = 0;
+    OUTPUT:
+	RETVAL
+
+int
+isupper(charstring)
+	unsigned char *	charstring
+    CODE:
+	unsigned char *s = charstring;
+	unsigned char *e = s + PL_na;	/* "PL_na" set by typemap side effect */
+	for (RETVAL = 1; RETVAL && s < e; s++)
+	    if (!isupper(*s))
+		RETVAL = 0;
+    OUTPUT:
+	RETVAL
+
+int
+isxdigit(charstring)
+	unsigned char *	charstring
+    CODE:
+	unsigned char *s = charstring;
+	unsigned char *e = s + PL_na;	/* "PL_na" set by typemap side effect */
+	for (RETVAL = 1; RETVAL && s < e; s++)
+	    if (!isxdigit(*s))
+		RETVAL = 0;
+    OUTPUT:
+	RETVAL
+
+SysRet
+open(filename, flags = O_RDONLY, mode = 0666)
+	char *		filename
+	int		flags
+	Mode_t		mode
+    CODE:
+	if (flags & (O_APPEND|O_CREAT|O_TRUNC|O_RDWR|O_WRONLY|O_EXCL))
+	    TAINT_PROPER("open");
+	RETVAL = open(filename, flags, mode);
+    OUTPUT:
+	RETVAL
+
+
+HV *
+localeconv()
+    CODE:
+#ifdef HAS_LOCALECONV
+	struct lconv *lcbuf;
+	RETVAL = newHV();
+	if (lcbuf = localeconv()) {
+	    /* the strings */
+	    if (lcbuf->decimal_point && *lcbuf->decimal_point)
+		hv_store(RETVAL, "decimal_point", 13,
+		    newSVpv(lcbuf->decimal_point, 0), 0);
+	    if (lcbuf->thousands_sep && *lcbuf->thousands_sep)
+		hv_store(RETVAL, "thousands_sep", 13,
+		    newSVpv(lcbuf->thousands_sep, 0), 0);
+#ifndef NO_LOCALECONV_GROUPING
+	    if (lcbuf->grouping && *lcbuf->grouping)
+		hv_store(RETVAL, "grouping", 8,
+		    newSVpv(lcbuf->grouping, 0), 0);
+#endif
+	    if (lcbuf->int_curr_symbol && *lcbuf->int_curr_symbol)
+		hv_store(RETVAL, "int_curr_symbol", 15,
+		    newSVpv(lcbuf->int_curr_symbol, 0), 0);
+	    if (lcbuf->currency_symbol && *lcbuf->currency_symbol)
+		hv_store(RETVAL, "currency_symbol", 15,
+		    newSVpv(lcbuf->currency_symbol, 0), 0);
+	    if (lcbuf->mon_decimal_point && *lcbuf->mon_decimal_point)
+		hv_store(RETVAL, "mon_decimal_point", 17,
+		    newSVpv(lcbuf->mon_decimal_point, 0), 0);
+#ifndef NO_LOCALECONV_MON_THOUSANDS_SEP
+	    if (lcbuf->mon_thousands_sep && *lcbuf->mon_thousands_sep)
+		hv_store(RETVAL, "mon_thousands_sep", 17,
+		    newSVpv(lcbuf->mon_thousands_sep, 0), 0);
+#endif                    
+#ifndef NO_LOCALECONV_MON_GROUPING
+	    if (lcbuf->mon_grouping && *lcbuf->mon_grouping)
+		hv_store(RETVAL, "mon_grouping", 12,
+		    newSVpv(lcbuf->mon_grouping, 0), 0);
+#endif
+	    if (lcbuf->positive_sign && *lcbuf->positive_sign)
+		hv_store(RETVAL, "positive_sign", 13,
+		    newSVpv(lcbuf->positive_sign, 0), 0);
+	    if (lcbuf->negative_sign && *lcbuf->negative_sign)
+		hv_store(RETVAL, "negative_sign", 13,
+		    newSVpv(lcbuf->negative_sign, 0), 0);
+	    /* the integers */
+	    if (lcbuf->int_frac_digits != CHAR_MAX)
+		hv_store(RETVAL, "int_frac_digits", 15,
+		    newSViv(lcbuf->int_frac_digits), 0);
+	    if (lcbuf->frac_digits != CHAR_MAX)
+		hv_store(RETVAL, "frac_digits", 11,
+		    newSViv(lcbuf->frac_digits), 0);
+	    if (lcbuf->p_cs_precedes != CHAR_MAX)
+		hv_store(RETVAL, "p_cs_precedes", 13,
+		    newSViv(lcbuf->p_cs_precedes), 0);
+	    if (lcbuf->p_sep_by_space != CHAR_MAX)
+		hv_store(RETVAL, "p_sep_by_space", 14,
+		    newSViv(lcbuf->p_sep_by_space), 0);
+	    if (lcbuf->n_cs_precedes != CHAR_MAX)
+		hv_store(RETVAL, "n_cs_precedes", 13,
+		    newSViv(lcbuf->n_cs_precedes), 0);
+	    if (lcbuf->n_sep_by_space != CHAR_MAX)
+		hv_store(RETVAL, "n_sep_by_space", 14,
+		    newSViv(lcbuf->n_sep_by_space), 0);
+	    if (lcbuf->p_sign_posn != CHAR_MAX)
+		hv_store(RETVAL, "p_sign_posn", 11,
+		    newSViv(lcbuf->p_sign_posn), 0);
+	    if (lcbuf->n_sign_posn != CHAR_MAX)
+		hv_store(RETVAL, "n_sign_posn", 11,
+		    newSViv(lcbuf->n_sign_posn), 0);
+	}
+#else
+	localeconv(); /* A stub to call not_here(). */
+#endif
+    OUTPUT:
+	RETVAL
+
+char *
+setlocale(category, locale = 0)
+	int		category
+	char *		locale
+    CODE:
+	RETVAL = setlocale(category, locale);
+	if (RETVAL) {
+#ifdef USE_LOCALE_CTYPE
+	    if (category == LC_CTYPE
+#ifdef LC_ALL
+		|| category == LC_ALL
+#endif
+		)
+	    {
+		char *newctype;
+#ifdef LC_ALL
+		if (category == LC_ALL)
+		    newctype = setlocale(LC_CTYPE, NULL);
+		else
+#endif
+		    newctype = RETVAL;
+		perl_new_ctype(newctype);
+	    }
+#endif /* USE_LOCALE_CTYPE */
+#ifdef USE_LOCALE_COLLATE
+	    if (category == LC_COLLATE
+#ifdef LC_ALL
+		|| category == LC_ALL
+#endif
+		)
+	    {
+		char *newcoll;
+#ifdef LC_ALL
+		if (category == LC_ALL)
+		    newcoll = setlocale(LC_COLLATE, NULL);
+		else
+#endif
+		    newcoll = RETVAL;
+		perl_new_collate(newcoll);
+	    }
+#endif /* USE_LOCALE_COLLATE */
+#ifdef USE_LOCALE_NUMERIC
+	    if (category == LC_NUMERIC
+#ifdef LC_ALL
+		|| category == LC_ALL
+#endif
+		)
+	    {
+		char *newnum;
+#ifdef LC_ALL
+		if (category == LC_ALL)
+		    newnum = setlocale(LC_NUMERIC, NULL);
+		else
+#endif
+		    newnum = RETVAL;
+		perl_new_numeric(newnum);
+	    }
+#endif /* USE_LOCALE_NUMERIC */
+	}
+    OUTPUT:
+	RETVAL
+
+
+double
+acos(x)
+	double		x
+
+double
+asin(x)
+	double		x
+
+double
+atan(x)
+	double		x
+
+double
+ceil(x)
+	double		x
+
+double
+cosh(x)
+	double		x
+
+double
+floor(x)
+	double		x
+
+double
+fmod(x,y)
+	double		x
+	double		y
+
+void
+frexp(x)
+	double		x
+    PPCODE:
+	int expvar;
+	/* (We already know stack is long enough.) */
+	PUSHs(sv_2mortal(newSVnv(frexp(x,&expvar))));
+	PUSHs(sv_2mortal(newSViv(expvar)));
+
+double
+ldexp(x,exp)
+	double		x
+	int		exp
+
+double
+log10(x)
+	double		x
+
+void
+modf(x)
+	double		x
+    PPCODE:
+	double intvar;
+	/* (We already know stack is long enough.) */
+	PUSHs(sv_2mortal(newSVnv(modf(x,&intvar))));
+	PUSHs(sv_2mortal(newSVnv(intvar)));
+
+double
+sinh(x)
+	double		x
+
+double
+tan(x)
+	double		x
+
+double
+tanh(x)
+	double		x
+
+SysRet
+sigaction(sig, action, oldaction = 0)
+	int			sig
+	POSIX::SigAction	action
+	POSIX::SigAction	oldaction
+    CODE:
+#ifdef WIN32
+	RETVAL = not_here("sigaction");
+#else
+# This code is really grody because we're trying to make the signal
+# interface look beautiful, which is hard.
+
+	if (!PL_siggv)
+	    gv_fetchpv("SIG", TRUE, SVt_PVHV);
+
+	{
+	    struct sigaction act;
+	    struct sigaction oact;
+	    POSIX__SigSet sigset;
+	    SV** svp;
+	    SV** sigsvp = hv_fetch(GvHVn(PL_siggv),
+				 sig_name[sig],
+				 strlen(sig_name[sig]),
+				 TRUE);
+
+	    /* Remember old handler name if desired. */
+	    if (oldaction) {
+		char *hand = SvPVx(*sigsvp, PL_na);
+		svp = hv_fetch(oldaction, "HANDLER", 7, TRUE);
+		sv_setpv(*svp, *hand ? hand : "DEFAULT");
+	    }
+
+	    if (action) {
+		/* Vector new handler through %SIG.  (We always use sighandler
+		   for the C signal handler, which reads %SIG to dispatch.) */
+		svp = hv_fetch(action, "HANDLER", 7, FALSE);
+		if (!svp)
+		    croak("Can't supply an action without a HANDLER");
+		sv_setpv(*sigsvp, SvPV(*svp, PL_na));
+		mg_set(*sigsvp);	/* handles DEFAULT and IGNORE */
+		act.sa_handler = sighandler;
+
+		/* Set up any desired mask. */
+		svp = hv_fetch(action, "MASK", 4, FALSE);
+		if (svp && sv_isa(*svp, "POSIX::SigSet")) {
+		    unsigned long tmp;
+		    tmp = (unsigned long)SvNV((SV*)SvRV(*svp));
+		    sigset = (sigset_t*) tmp;
+		    act.sa_mask = *sigset;
+		}
+		else
+		    sigemptyset(& act.sa_mask);
+
+		/* Set up any desired flags. */
+		svp = hv_fetch(action, "FLAGS", 5, FALSE);
+		act.sa_flags = svp ? SvIV(*svp) : 0;
+	    }
+
+	    /* Now work around sigaction oddities */
+	    if (action && oldaction)
+		RETVAL = sigaction(sig, & act, & oact);
+	    else if (action)
+		RETVAL = sigaction(sig, & act, (struct sigaction *)0);
+	    else if (oldaction)
+		RETVAL = sigaction(sig, (struct sigaction *)0, & oact);
+	    else
+		RETVAL = -1;
+
+	    if (oldaction) {
+		/* Get back the mask. */
+		svp = hv_fetch(oldaction, "MASK", 4, TRUE);
+		if (sv_isa(*svp, "POSIX::SigSet")) {
+		    unsigned long tmp;
+		    tmp = (unsigned long)SvNV((SV*)SvRV(*svp));
+		    sigset = (sigset_t*) tmp;
+		}
+		else {
+		    sigset = (sigset_t*)safemalloc(sizeof(sigset_t));
+		    sv_setptrobj(*svp, sigset, "POSIX::SigSet");
+		}
+		*sigset = oact.sa_mask;
+
+		/* Get back the flags. */
+		svp = hv_fetch(oldaction, "FLAGS", 5, TRUE);
+		sv_setiv(*svp, oact.sa_flags);
+	    }
+	}
+#endif
+    OUTPUT:
+	RETVAL
+
+SysRet
+sigpending(sigset)
+	POSIX::SigSet		sigset
+
+SysRet
+sigprocmask(how, sigset, oldsigset = 0)
+	int			how
+	POSIX::SigSet		sigset
+	POSIX::SigSet		oldsigset
+
+SysRet
+sigsuspend(signal_mask)
+	POSIX::SigSet		signal_mask
+
+void
+_exit(status)
+	int		status
+
+SysRet
+close(fd)
+	int		fd
+
+SysRet
+dup(fd)
+	int		fd
+
+SysRet
+dup2(fd1, fd2)
+	int		fd1
+	int		fd2
+
+SysRetLong
+lseek(fd, offset, whence)
+	int		fd
+	Off_t		offset
+	int		whence
+
+SysRet
+nice(incr)
+	int		incr
+
+int
+pipe()
+    PPCODE:
+	int fds[2];
+	if (pipe(fds) != -1) {
+	    EXTEND(SP,2);
+	    PUSHs(sv_2mortal(newSViv(fds[0])));
+	    PUSHs(sv_2mortal(newSViv(fds[1])));
+	}
+
+SysRet
+read(fd, buffer, nbytes)
+    PREINIT:
+        SV *sv_buffer = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
+    INPUT:
+        int             fd
+        size_t          nbytes
+        char *          buffer = sv_grow( sv_buffer, nbytes+1 );
+    CLEANUP:
+        if (RETVAL >= 0) {
+            SvCUR(sv_buffer) = RETVAL;
+            SvPOK_only(sv_buffer);
+            *SvEND(sv_buffer) = '\0';
+            SvTAINTED_on(sv_buffer);
+        }
+
+SysRet
+setpgid(pid, pgid)
+	pid_t		pid
+	pid_t		pgid
+
+pid_t
+setsid()
+
+pid_t
+tcgetpgrp(fd)
+	int		fd
+
+SysRet
+tcsetpgrp(fd, pgrp_id)
+	int		fd
+	pid_t		pgrp_id
+
+int
+uname()
+    PPCODE:
+#ifdef HAS_UNAME
+	struct utsname buf;
+	if (uname(&buf) >= 0) {
+	    EXTEND(SP, 5);
+	    PUSHs(sv_2mortal(newSVpv(buf.sysname, 0)));
+	    PUSHs(sv_2mortal(newSVpv(buf.nodename, 0)));
+	    PUSHs(sv_2mortal(newSVpv(buf.release, 0)));
+	    PUSHs(sv_2mortal(newSVpv(buf.version, 0)));
+	    PUSHs(sv_2mortal(newSVpv(buf.machine, 0)));
+	}
+#else
+	uname((char *) 0); /* A stub to call not_here(). */
+#endif
+
+SysRet
+write(fd, buffer, nbytes)
+	int		fd
+	char *		buffer
+	size_t		nbytes
+
+char *
+tmpnam(s = 0)
+	char *		s = 0;
+
+void
+abort()
+
+int
+mblen(s, n)
+	char *		s
+	size_t		n
+
+size_t
+mbstowcs(s, pwcs, n)
+	wchar_t *	s
+	char *		pwcs
+	size_t		n
+
+int
+mbtowc(pwc, s, n)
+	wchar_t *	pwc
+	char *		s
+	size_t		n
+
+int
+wcstombs(s, pwcs, n)
+	char *		s
+	wchar_t *	pwcs
+	size_t		n
+
+int
+wctomb(s, wchar)
+	char *		s
+	wchar_t		wchar
+
+int
+strcoll(s1, s2)
+	char *		s1
+	char *		s2
+
+void
+strtod(str)
+	char *		str
+    PREINIT:
+	double num;
+	char *unparsed;
+    PPCODE:
+	SET_NUMERIC_LOCAL();
+	num = strtod(str, &unparsed);
+	PUSHs(sv_2mortal(newSVnv(num)));
+	if (GIMME == G_ARRAY) {
+	    EXTEND(SP, 1);
+	    if (unparsed)
+		PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
+	    else
+		PUSHs(&PL_sv_undef);
+	}
+
+void
+strtol(str, base = 0)
+	char *		str
+	int		base
+    PREINIT:
+	long num;
+	char *unparsed;
+    PPCODE:
+	num = strtol(str, &unparsed, base);
+	if (num >= IV_MIN && num <= IV_MAX)
+	    PUSHs(sv_2mortal(newSViv((IV)num)));
+	else
+	    PUSHs(sv_2mortal(newSVnv((double)num)));
+	if (GIMME == G_ARRAY) {
+	    EXTEND(SP, 1);
+	    if (unparsed)
+		PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
+	    else
+		PUSHs(&PL_sv_undef);
+	}
+
+void
+strtoul(str, base = 0)
+	char *		str
+	int		base
+    PREINIT:
+	unsigned long num;
+	char *unparsed;
+    PPCODE:
+	num = strtoul(str, &unparsed, base);
+	if (num <= IV_MAX)
+	    PUSHs(sv_2mortal(newSViv((IV)num)));
+	else
+	    PUSHs(sv_2mortal(newSVnv((double)num)));
+	if (GIMME == G_ARRAY) {
+	    EXTEND(SP, 1);
+	    if (unparsed)
+		PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
+	    else
+		PUSHs(&PL_sv_undef);
+	}
+
+SV *
+strxfrm(src)
+	SV *		src
+    CODE:
+	{
+          STRLEN srclen;
+          STRLEN dstlen;
+          char *p = SvPV(src,srclen);
+          srclen++;
+          ST(0) = sv_2mortal(NEWSV(800,srclen));
+          dstlen = strxfrm(SvPVX(ST(0)), p, (size_t)srclen);
+          if (dstlen > srclen) {
+              dstlen++;
+              SvGROW(ST(0), dstlen);
+              strxfrm(SvPVX(ST(0)), p, (size_t)dstlen);
+              dstlen--;
+          }
+          SvCUR(ST(0)) = dstlen;
+	    SvPOK_only(ST(0));
+	}
+
+SysRet
+mkfifo(filename, mode)
+	char *		filename
+	Mode_t		mode
+    CODE:
+	TAINT_PROPER("mkfifo");
+	RETVAL = mkfifo(filename, mode);
+    OUTPUT:
+	RETVAL
+
+SysRet
+tcdrain(fd)
+	int		fd
+
+
+SysRet
+tcflow(fd, action)
+	int		fd
+	int		action
+
+
+SysRet
+tcflush(fd, queue_selector)
+	int		fd
+	int		queue_selector
+
+SysRet
+tcsendbreak(fd, duration)
+	int		fd
+	int		duration
+
+char *
+asctime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = 0)
+	int		sec
+	int		min
+	int		hour
+	int		mday
+	int		mon
+	int		year
+	int		wday
+	int		yday
+	int		isdst
+    CODE:
+	{
+	    struct tm mytm;
+	    init_tm(&mytm);	/* XXX workaround - see init_tm() above */
+	    mytm.tm_sec = sec;
+	    mytm.tm_min = min;
+	    mytm.tm_hour = hour;
+	    mytm.tm_mday = mday;
+	    mytm.tm_mon = mon;
+	    mytm.tm_year = year;
+	    mytm.tm_wday = wday;
+	    mytm.tm_yday = yday;
+	    mytm.tm_isdst = isdst;
+	    RETVAL = asctime(&mytm);
+	}
+    OUTPUT:
+	RETVAL
+
+long
+clock()
+
+char *
+ctime(time)
+	Time_t		&time
+
+void
+times()
+	PPCODE:
+	struct tms tms;
+	clock_t realtime;
+	realtime = times( &tms );
+	EXTEND(SP,5);
+	PUSHs( sv_2mortal( newSViv( (IV) realtime ) ) );
+	PUSHs( sv_2mortal( newSViv( (IV) tms.tms_utime ) ) );
+	PUSHs( sv_2mortal( newSViv( (IV) tms.tms_stime ) ) );
+	PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cutime ) ) );
+	PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cstime ) ) );
+
+double
+difftime(time1, time2)
+	Time_t		time1
+	Time_t		time2
+
+SysRetLong
+mktime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = 0)
+	int		sec
+	int		min
+	int		hour
+	int		mday
+	int		mon
+	int		year
+	int		wday
+	int		yday
+	int		isdst
+    CODE:
+	{
+	    struct tm mytm;
+	    init_tm(&mytm);	/* XXX workaround - see init_tm() above */
+	    mytm.tm_sec = sec;
+	    mytm.tm_min = min;
+	    mytm.tm_hour = hour;
+	    mytm.tm_mday = mday;
+	    mytm.tm_mon = mon;
+	    mytm.tm_year = year;
+	    mytm.tm_wday = wday;
+	    mytm.tm_yday = yday;
+	    mytm.tm_isdst = isdst;
+	    RETVAL = mktime(&mytm);
+	}
+    OUTPUT:
+	RETVAL
+
+char *
+strftime(fmt, sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = 0)
+	char *		fmt
+	int		sec
+	int		min
+	int		hour
+	int		mday
+	int		mon
+	int		year
+	int		wday
+	int		yday
+	int		isdst
+    CODE:
+	{
+	    char tmpbuf[128];
+	    struct tm mytm;
+	    int len;
+	    init_tm(&mytm);	/* XXX workaround - see init_tm() above */
+	    mytm.tm_sec = sec;
+	    mytm.tm_min = min;
+	    mytm.tm_hour = hour;
+	    mytm.tm_mday = mday;
+	    mytm.tm_mon = mon;
+	    mytm.tm_year = year;
+	    mytm.tm_wday = wday;
+	    mytm.tm_yday = yday;
+	    mytm.tm_isdst = isdst;
+	    len = strftime(tmpbuf, sizeof tmpbuf, fmt, &mytm);
+	    ST(0) = sv_2mortal(newSVpv(tmpbuf, len));
+	}
+
+void
+tzset()
+
+void
+tzname()
+    PPCODE:
+	EXTEND(SP,2);
+	PUSHs(sv_2mortal(newSVpv(tzname[0],strlen(tzname[0]))));
+	PUSHs(sv_2mortal(newSVpv(tzname[1],strlen(tzname[1]))));
+
+SysRet
+access(filename, mode)
+	char *		filename
+	Mode_t		mode
+
+char *
+ctermid(s = 0)
+	char *		s = 0;
+
+char *
+cuserid(s = 0)
+	char *		s = 0;
+
+SysRetLong
+fpathconf(fd, name)
+	int		fd
+	int		name
+
+SysRetLong
+pathconf(filename, name)
+	char *		filename
+	int		name
+
+SysRet
+pause()
+
+SysRetLong
+sysconf(name)
+	int		name
+
+char *
+ttyname(fd)
+	int		fd
diff --git a/contrib/perl5/ext/POSIX/hints/bsdos.pl b/contrib/perl5/ext/POSIX/hints/bsdos.pl
new file mode 100644
index 0000000..62732ac
--- /dev/null
+++ b/contrib/perl5/ext/POSIX/hints/bsdos.pl
@@ -0,0 +1,3 @@
+# BSD platforms have extra fields in struct tm that need to be initialized.
+#  XXX A Configure test is needed.
+$self->{CCFLAGS} = $Config{ccflags} . ' -DSTRUCT_TM_HASZONE' ;
diff --git a/contrib/perl5/ext/POSIX/hints/freebsd.pl b/contrib/perl5/ext/POSIX/hints/freebsd.pl
new file mode 100644
index 0000000..62732ac
--- /dev/null
+++ b/contrib/perl5/ext/POSIX/hints/freebsd.pl
@@ -0,0 +1,3 @@
+# BSD platforms have extra fields in struct tm that need to be initialized.
+#  XXX A Configure test is needed.
+$self->{CCFLAGS} = $Config{ccflags} . ' -DSTRUCT_TM_HASZONE' ;
diff --git a/contrib/perl5/ext/POSIX/hints/linux.pl b/contrib/perl5/ext/POSIX/hints/linux.pl
new file mode 100644
index 0000000..f1d1981
--- /dev/null
+++ b/contrib/perl5/ext/POSIX/hints/linux.pl
@@ -0,0 +1,5 @@
+# libc6, aka glibc2, seems to need STRUCT_TM_HASZONE defined.
+# Thanks to Bart Schuller <schuller@Lunatech.com>
+# See Message-ID: <19971009002636.50729@tanglefoot>
+#  XXX A Configure test is needed.
+$self->{CCFLAGS} = $Config{ccflags} . ' -DSTRUCT_TM_HASZONE -DHINT_SC_EXIST' ;
diff --git a/contrib/perl5/ext/POSIX/hints/netbsd.pl b/contrib/perl5/ext/POSIX/hints/netbsd.pl
new file mode 100644
index 0000000..62732ac
--- /dev/null
+++ b/contrib/perl5/ext/POSIX/hints/netbsd.pl
@@ -0,0 +1,3 @@
+# BSD platforms have extra fields in struct tm that need to be initialized.
+#  XXX A Configure test is needed.
+$self->{CCFLAGS} = $Config{ccflags} . ' -DSTRUCT_TM_HASZONE' ;
diff --git a/contrib/perl5/ext/POSIX/hints/next_3.pl b/contrib/perl5/ext/POSIX/hints/next_3.pl
new file mode 100644
index 0000000..d907783
--- /dev/null
+++ b/contrib/perl5/ext/POSIX/hints/next_3.pl
@@ -0,0 +1,5 @@
+# NeXT *does* have setpgid when we use the -posix flag, but
+# doesn't when we don't.  The main perl sources are compiled
+# without -posix, so the hints/next_3.sh hint file tells Configure
+# that  d_setpgid=undef.
+$self->{CCFLAGS} = $Config{ccflags} . ' -posix -DHAS_SETPGID' ;
diff --git a/contrib/perl5/ext/POSIX/hints/openbsd.pl b/contrib/perl5/ext/POSIX/hints/openbsd.pl
new file mode 100644
index 0000000..62732ac
--- /dev/null
+++ b/contrib/perl5/ext/POSIX/hints/openbsd.pl
@@ -0,0 +1,3 @@
+# BSD platforms have extra fields in struct tm that need to be initialized.
+#  XXX A Configure test is needed.
+$self->{CCFLAGS} = $Config{ccflags} . ' -DSTRUCT_TM_HASZONE' ;
diff --git a/contrib/perl5/ext/POSIX/hints/sunos_4.pl b/contrib/perl5/ext/POSIX/hints/sunos_4.pl
new file mode 100644
index 0000000..32b3558
--- /dev/null
+++ b/contrib/perl5/ext/POSIX/hints/sunos_4.pl
@@ -0,0 +1,10 @@
+# SunOS 4.1.3 has two extra fields in struct tm.  This works around
+# the problem.  Other BSD platforms may have similar problems.
+# This state of affairs also persists in glibc2, found
+# on linux systems running libc6.
+#  XXX A Configure test is needed.
+
+# Although <unistd.h> is inappropriate in general for SunOS, we need it
+# in POSIX.xs to get the correct prototype for ttyname().
+
+$self->{CCFLAGS} = $Config{ccflags} . ' -DSTRUCT_TM_HASZONE -DI_UNISTD' ;
diff --git a/contrib/perl5/ext/POSIX/typemap b/contrib/perl5/ext/POSIX/typemap
new file mode 100644
index 0000000..63e41c7
--- /dev/null
+++ b/contrib/perl5/ext/POSIX/typemap
@@ -0,0 +1,14 @@
+Mode_t			T_NV
+pid_t			T_NV
+Uid_t			T_NV
+Time_t			T_NV
+Gid_t			T_NV
+Off_t			T_NV
+Dev_t			T_NV
+fd			T_IV
+speed_t			T_IV
+tcflag_t		T_IV
+cc_t			T_IV
+POSIX::SigSet		T_PTROBJ
+POSIX::Termios		T_PTROBJ
+POSIX::SigAction	T_HVREF
diff --git a/contrib/perl5/ext/SDBM_File/Makefile.PL b/contrib/perl5/ext/SDBM_File/Makefile.PL
new file mode 100644
index 0000000..b639b29
--- /dev/null
+++ b/contrib/perl5/ext/SDBM_File/Makefile.PL
@@ -0,0 +1,35 @@
+use ExtUtils::MakeMaker;
+
+# The existence of the ./sdbm/Makefile.PL file causes MakeMaker
+# to automatically include Makefile code for the targets
+#	config, all, clean, realclean and sdbm/Makefile
+# which perform the corresponding actions in the subdirectory.
+
+$define = ($^O eq 'MSWin32') ? '-DMSDOS' : '';
+if ($^O eq 'MSWin32') { $myextlib = 'sdbm\\libsdbm$(LIB_EXT)'; }
+else                  { $myextlib = 'sdbm/libsdbm$(LIB_EXT)';  }
+
+WriteMakefile(
+              NAME	=> 'SDBM_File',
+              MYEXTLIB => $myextlib,
+              MAN3PODS 	=> ' ', 	# Pods will be built by installman.
+              XSPROTOARG => '-noprototypes', 		# XXX remove later?
+              VERSION_FROM => 'SDBM_File.pm',
+              DEFINE => $define,
+             );
+
+sub MY::postamble {
+  if ($^O ne 'VMS') {
+    '
+$(MYEXTLIB): sdbm/Makefile
+	cd sdbm && $(MAKE) all
+';
+  } else {
+  '   
+$(MYEXTLIB) : [.sdbm]descrip.mms
+	set def [.sdbm]
+    $(MMS) all
+    set def [-]
+';  
+  }
+}
diff --git a/contrib/perl5/ext/SDBM_File/SDBM_File.pm b/contrib/perl5/ext/SDBM_File/SDBM_File.pm
new file mode 100644
index 0000000..a2d4df8
--- /dev/null
+++ b/contrib/perl5/ext/SDBM_File/SDBM_File.pm
@@ -0,0 +1,35 @@
+package SDBM_File;
+
+use strict;
+use vars qw($VERSION @ISA);
+
+require Tie::Hash;
+require DynaLoader;
+
+@ISA = qw(Tie::Hash DynaLoader);
+
+$VERSION = "1.00" ;
+
+bootstrap SDBM_File $VERSION;
+
+1;
+
+__END__
+
+=head1 NAME
+
+SDBM_File - Tied access to sdbm files
+
+=head1 SYNOPSIS
+
+ use SDBM_File;
+
+ tie(%h, 'SDBM_File', 'Op.dbmx', O_RDWR|O_CREAT, 0640);
+
+ untie %h;
+
+=head1 DESCRIPTION
+
+See L<perlfunc/tie>
+
+=cut
diff --git a/contrib/perl5/ext/SDBM_File/SDBM_File.xs b/contrib/perl5/ext/SDBM_File/SDBM_File.xs
new file mode 100644
index 0000000..38eaebf
--- /dev/null
+++ b/contrib/perl5/ext/SDBM_File/SDBM_File.xs
@@ -0,0 +1,71 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#include "sdbm/sdbm.h"
+
+typedef DBM* SDBM_File;
+#define sdbm_TIEHASH(dbtype,filename,flags,mode) sdbm_open(filename,flags,mode)
+#define sdbm_FETCH(db,key)			sdbm_fetch(db,key)
+#define sdbm_STORE(db,key,value,flags)		sdbm_store(db,key,value,flags)
+#define sdbm_DELETE(db,key)			sdbm_delete(db,key)
+#define sdbm_FIRSTKEY(db)			sdbm_firstkey(db)
+#define sdbm_NEXTKEY(db,key)			sdbm_nextkey(db)
+
+
+MODULE = SDBM_File	PACKAGE = SDBM_File	PREFIX = sdbm_
+
+SDBM_File
+sdbm_TIEHASH(dbtype, filename, flags, mode)
+	char *		dbtype
+	char *		filename
+	int		flags
+	int		mode
+
+void
+sdbm_DESTROY(db)
+	SDBM_File	db
+	CODE:
+	sdbm_close(db);
+
+datum
+sdbm_FETCH(db, key)
+	SDBM_File	db
+	datum		key
+
+int
+sdbm_STORE(db, key, value, flags = DBM_REPLACE)
+	SDBM_File	db
+	datum		key
+	datum		value
+	int		flags
+    CLEANUP:
+	if (RETVAL) {
+	    if (RETVAL < 0 && errno == EPERM)
+		croak("No write permission to sdbm file");
+	    croak("sdbm store returned %d, errno %d, key \"%s\"",
+			RETVAL,errno,key.dptr);
+	    sdbm_clearerr(db);
+	}
+
+int
+sdbm_DELETE(db, key)
+	SDBM_File	db
+	datum		key
+
+datum
+sdbm_FIRSTKEY(db)
+	SDBM_File	db
+
+datum
+sdbm_NEXTKEY(db, key)
+	SDBM_File	db
+	datum		key
+
+int
+sdbm_error(db)
+	SDBM_File	db
+
+int
+sdbm_clearerr(db)
+	SDBM_File	db
+
diff --git a/contrib/perl5/ext/SDBM_File/sdbm/CHANGES b/contrib/perl5/ext/SDBM_File/sdbm/CHANGES
new file mode 100644
index 0000000..f7296d1
--- /dev/null
+++ b/contrib/perl5/ext/SDBM_File/sdbm/CHANGES
@@ -0,0 +1,18 @@
+Changes from the earlier BETA releases.
+
+o dbm_prep does everything now, so dbm_open is just a simple
+  wrapper that builds the default filenames. dbm_prep no longer
+  requires a (DBM *) db parameter: it allocates one itself. It
+  returns (DBM *) db or (DBM *) NULL.
+
+o makroom is now reliable. In the common-case optimization of the page
+  split, the page into which the incoming key/value pair is to be inserted
+  is write-deferred (if the split is successful), thereby saving a cosly
+  write.  BUT, if the split does not make enough room (unsuccessful), the
+  deferred page is written out, as the failure-window is now dependent on
+  the number of split attempts.
+
+o if -DDUFF is defined, hash function will also use the DUFF construct.
+  This may look like a micro-performance tweak (maybe it is), but in fact,
+  the hash function is the third most-heavily used function, after read
+  and write.
diff --git a/contrib/perl5/ext/SDBM_File/sdbm/COMPARE b/contrib/perl5/ext/SDBM_File/sdbm/COMPARE
new file mode 100644
index 0000000..a595e83
--- /dev/null
+++ b/contrib/perl5/ext/SDBM_File/sdbm/COMPARE
@@ -0,0 +1,88 @@
+
+Script started on Thu Sep 28 15:41:06 1989
+% uname -a
+titan titan 4_0 UMIPS mips
+% make all x-dbm
+        cc -O -DSDBM -DDUFF -DDUPERROR -DSPLITFAIL -c dbm.c
+        cc -O -DSDBM -DDUFF -DDUPERROR -DSPLITFAIL -c sdbm.c
+        cc -O -DSDBM -DDUFF -DDUPERROR -DSPLITFAIL -c pair.c
+        cc -O -DSDBM -DDUFF -DDUPERROR -DSPLITFAIL -c hash.c
+        ar cr libsdbm.a sdbm.o pair.o hash.o
+        ranlib libsdbm.a
+        cc  -o dbm dbm.o libsdbm.a
+        cc -O -DSDBM -DDUFF -DDUPERROR -DSPLITFAIL -c dba.c
+        cc  -o dba dba.o
+        cc -O -DSDBM -DDUFF -DDUPERROR -DSPLITFAIL -c dbd.c
+        cc  -o dbd dbd.o
+        cc -O -DSDBM -DDUFF -DDUPERROR -DSPLITFAIL -o x-dbm dbm.o
+% 
+% 
+% wc history
+  65110 218344 3204883 history
+% 
+% /bin/time dbm build foo <history
+
+real     5:56.9
+user       13.3
+sys        26.3
+% ls -s
+total 14251
+   5 README           2 dbd.c            1 hash.c           1 pair.h
+   0 SCRIPT           5 dbd.o            1 hash.o           5 pair.o
+   1 WISHLIST        62 dbm           3130 history          1 port.h
+  46 dba              5 dbm.c           11 howtodbm.txt    11 sdbm.c
+   3 dba.c            8 dbm.o           14 libsdbm.a        2 sdbm.h
+   6 dba.o            4 foo.dir          1 makefile         8 sdbm.o
+  46 dbd           10810 foo.pag         6 pair.c          60 x-dbm
+% ls -l foo.*
+-rw-r--r--  1 oz           4096 Sep 28 15:48 foo.dir
+-rw-r--r--  1 oz       11069440 Sep 28 15:48 foo.pag
+% 
+% /bin/time x-dbm build bar <history
+
+real     5:59.4
+user       24.7
+sys        29.1
+% 
+% ls -s
+total 27612
+   5 README          46 dbd              1 hash.c           5 pair.o
+   1 SCRIPT           2 dbd.c            1 hash.o           1 port.h
+   1 WISHLIST         5 dbd.o         3130 history         11 sdbm.c
+   4 bar.dir         62 dbm             11 howtodbm.txt     2 sdbm.h
+13356 bar.pag         5 dbm.c           14 libsdbm.a        8 sdbm.o
+  46 dba              8 dbm.o            1 makefile        60 x-dbm
+   3 dba.c            4 foo.dir          6 pair.c
+   6 dba.o         10810 foo.pag         1 pair.h
+% 
+% ls -l bar.*
+-rw-r--r--  1 oz           4096 Sep 28 15:54 bar.dir
+-rw-r--r--  1 oz       13676544 Sep 28 15:54 bar.pag
+% 
+% dba foo | tail
+#10801: ok. no entries.
+#10802: ok. no entries.
+#10803: ok. no entries.
+#10804: ok. no entries.
+#10805: ok. no entries.
+#10806: ok. no entries.
+#10807: ok. no entries.
+#10808: ok. no entries.
+#10809: ok.  11 entries 67% used free 337.
+10810 pages (6036 holes):  65073 entries
+% 
+% dba bar | tail
+#13347: ok. no entries.
+#13348: ok. no entries.
+#13349: ok. no entries.
+#13350: ok. no entries.
+#13351: ok. no entries.
+#13352: ok. no entries.
+#13353: ok. no entries.
+#13354: ok. no entries.
+#13355: ok.   7 entries 33% used free 676.
+13356 pages (8643 holes):  65073 entries
+%
+% exit
+script done on Thu Sep 28 16:08:45 1989
+
diff --git a/contrib/perl5/ext/SDBM_File/sdbm/Makefile.PL b/contrib/perl5/ext/SDBM_File/sdbm/Makefile.PL
new file mode 100644
index 0000000..e6fdcf9
--- /dev/null
+++ b/contrib/perl5/ext/SDBM_File/sdbm/Makefile.PL
@@ -0,0 +1,65 @@
+use ExtUtils::MakeMaker;
+
+$define = '-DSDBM -DDUFF';
+$define .= ' -DWIN32 -DPERL_STATIC_SYMS' if ($^O eq 'MSWin32');
+
+if ($^O eq 'VMS') {  # Old VAXC compiler can't handle Duff's device
+    require Config;
+    $define =~ s/\s+-DDUFF// if $Config::Config{'vms_cc_type'} eq 'vaxc';
+}
+
+WriteMakefile(
+    NAME      => 'sdbm', # (doesn't matter what the name is here) oh yes it does
+#    LINKTYPE  => 'static',
+    DEFINE    => $define,
+    INC       => '-I$(PERL_INC)', # force PERL_INC dir ahead of system -I's
+    INST_ARCHLIB => '.',
+    SKIP      => [qw(dynamic dynamic_lib dlsyms)],
+    OBJECT    => '$(O_FILES)',
+    clean     => {'FILES' => 'dbu libsdbm.a dbd dba dbe x-dbu *.dir *.pag'},
+    H         => [qw(tune.h sdbm.h pair.h $(PERL_INC)/config.h)],
+    C         => [qw(sdbm.c pair.c hash.c)]
+);
+
+sub MY::constants {
+  package MY;
+  my $r = shift->SUPER::constants();
+  if ($^O eq 'VMS') {
+    $r =~ s/^INST_STATIC =.*$/INST_STATIC = libsdbm\$(LIB_EXT)/m
+  }
+  return $r;
+}
+
+sub MY::post_constants {
+  package MY;
+  if ($^O eq 'VMS') {
+    shift->SUPER::post_constants();
+  } else {
+'
+INST_STATIC = libsdbm$(LIB_EXT)
+'
+  }
+}
+
+sub MY::top_targets {
+    my $r = '
+all :: static
+	$(NOECHO) $(NOOP)
+
+config ::
+	$(NOECHO) $(NOOP)
+
+lint:
+	lint -abchx $(LIBSRCS)
+
+';
+    $r .= '
+# This is a workaround, the problem is that our old GNU make exports
+# variables into the environment so $(MYEXTLIB) is set in here to this
+# value which can not be built.
+sdbm/libsdbm.a:
+	$(NOECHO) $(NOOP)
+' unless $^O eq 'VMS';
+
+    return $r;
+}
diff --git a/contrib/perl5/ext/SDBM_File/sdbm/README b/contrib/perl5/ext/SDBM_File/sdbm/README
new file mode 100644
index 0000000..cd7312c
--- /dev/null
+++ b/contrib/perl5/ext/SDBM_File/sdbm/README
@@ -0,0 +1,396 @@
+
+
+
+
+
+
+                   sdbm - Substitute DBM
+                             or
+        Berkeley ndbm for Every UN*X[1] Made Simple
+
+                      Ozan (oz) Yigit
+
+            The Guild of PD Software Toolmakers
+                      Toronto - Canada
+
+                     oz@nexus.yorku.ca
+
+
+
+Implementation is the sincerest form of flattery. - L. Peter
+Deutsch
+
+A The Clone of the ndbm library
+
+     The sources accompanying this notice - sdbm  -  consti-
+tute  the  first  public  release  (Dec. 1990) of a complete
+clone of the Berkeley UN*X ndbm library. The sdbm library is
+meant  to  clone the proven functionality of ndbm as closely
+as possible, including a few improvements. It is  practical,
+easy to understand, and compatible.  The sdbm library is not
+derived  from  any  licensed,  proprietary  or   copyrighted
+software.
+
+     The sdbm implementation is based on  a  1978  algorithm
+[Lar78] by P.-A. (Paul) Larson known as ``Dynamic Hashing''.
+In the course of searching for a substitute for ndbm, I pro-
+totyped  three different external-hashing algorithms [Lar78,
+Fag79, Lit80] and ultimately chose Larson's algorithm  as  a
+basis  of  the  sdbm  implementation. The Bell Labs dbm (and
+therefore ndbm) is based on an  algorithm  invented  by  Ken
+Thompson, [Tho90, Tor87] and predates Larson's work.
+
+     The sdbm programming interface  is  totally  compatible
+with ndbm and includes a slight improvement in database ini-
+tialization.  It is also expected  to  be  binary-compatible
+under most UN*X versions that support the ndbm library.
+
+     The sdbm implementation shares the shortcomings of  the
+ndbm library, as a side effect of various simplifications to
+the original Larson algorithm. It does produce holes in  the
+page file as it writes pages past the end of file. (Larson's
+paper include a clever solution to this problem  that  is  a
+result of using the hash value directly as a block address.)
+On the other hand, extensive tests  seem  to  indicate  that
+sdbm creates fewer holes in general, and the resulting page-
+files are smaller. The sdbm implementation  is  also  faster
+than  ndbm  in database creation.  Unlike the ndbm, the sdbm
+_________________________
+
+  [1] UN*X is not a trademark of any (dis)organization.
+
+
+
+
+
+
+
+
+
+                           - 2 -
+
+
+store operation will not ``wander away'' trying to split its
+data  pages  to insert a datum that cannot (due to elaborate
+worst-case situations) be inserted. (It will  fail  after  a
+pre-defined number of attempts.)
+
+Important Compatibility Warning
+
+     The sdbm and ndbm libraries cannot share databases: one
+cannot  read  the  (dir/pag)  database created by the other.
+This is due to the differences between  the  ndbm  and  sdbm
+algorithms[2], and the hash functions used.  It is  easy  to
+convert  between the dbm/ndbm databases and sdbm by ignoring
+the index completely: see dbd, dbu etc.
+
+
+Notice of Intellectual Property
+
+The entire sdbm  library package, as authored by me, Ozan S.
+Yigit,  is  hereby placed in the public domain. As such, the
+author is not responsible for the  consequences  of  use  of
+this  software, no matter how awful, even if they arise from
+defects in it. There is no expressed or implied warranty for
+the sdbm library.
+
+     Since the sdbm library package is in the public domain,
+this   original  release  or  any  additional  public-domain
+releases of the modified original cannot possibly (by defin-
+ition) be withheld from you. Also by definition, You (singu-
+lar) have all the rights to this code (including  the  right
+to sell without permission, the right to  hoard[3]  and  the
+right  to  do  other  icky  things as you see fit) but those
+rights are also granted to everyone else.
+
+     Please note that all  previous  distributions  of  this
+software  contained  a  copyright  (which is now dropped) to
+protect its origins and its  current  public  domain  status
+against any possible claims and/or challenges.
+
+Acknowledgments
+
+     Many people have been very helpful and  supportive.   A
+partial  list  would  necessarily  include Rayan Zacherissen
+(who contributed the  man  page,  and  also  hacked  a  MMAP
+_________________________
+
+  [2] Torek's   discussion   [Tor87]   indicates   that
+dbm/ndbm implementations use the hash value to traverse
+the radix trie differently than sdbm and as  a  result,
+the page indexes are generated in different order.  For
+more information, send e-mail to the author.
+  [3] You  cannot really hoard something that is avail-
+able to the public at large, but try if  it  makes  you
+feel any better.
+
+
+
+
+
+
+
+
+
+
+                           - 3 -
+
+
+version of sdbm), Arnold Robbins, Chris Lewis,  Bill  David-
+sen,  Henry  Spencer,  Geoff  Collyer, Rich Salz (who got me
+started in the first place), Johannes Ruschein (who did  the
+minix port) and David Tilbrook. I thank you all.
+
+Distribution Manifest and Notes
+
+This distribution of sdbm includes (at least) the following:
+
+    CHANGES     change log
+    README      this file.
+    biblio      a small bibliography on external hashing
+    dba.c       a crude (n/s)dbm page file analyzer
+    dbd.c       a crude (n/s)dbm page file dumper (for conversion)
+    dbe.1       man page for dbe.c
+    dbe.c       Janick's database editor
+    dbm.c       a dbm library emulation wrapper for ndbm/sdbm
+    dbm.h       header file for the above
+    dbu.c       a crude db management utility
+    hash.c      hashing function
+    makefile    guess.
+    pair.c      page-level routines (posted earlier)
+    pair.h      header file for the above
+    readme.ms   troff source for the README file
+    sdbm.3      man page
+    sdbm.c      the real thing
+    sdbm.h      header file for the above
+    tune.h      place for tuning & portability thingies
+    util.c      miscellaneous
+
+     dbu is a simple database manipulation  program[4]  that
+tries to look like Bell Labs' cbt utility. It  is  currently
+incomplete in functionality.  I use dbu to test out the rou-
+tines: it takes (from stdin) tab separated  key/value  pairs
+for commands like build or insert or takes keys for commands
+like delete or look.
+
+    dbu <build|creat|look|insert|cat|delete> dbmfile
+
+     dba is a crude analyzer of dbm/sdbm/ndbm page files. It
+scans the entire page file, reporting page level statistics,
+and totals at the end.
+
+     dbd is a crude dump  program  for  dbm/ndbm/sdbm  data-
+bases.  It  ignores  the bitmap, and dumps the data pages in
+sequence. It can be used to create input for the  dbu  util-
+ity.   Note that dbd will skip any NULLs in the key and data
+fields,  thus  is  unsuitable  to  convert   some   peculiar
+_________________________
+
+  [4] The dbd, dba, dbu utilities are quick  hacks  and
+are  not  fit  for  production use. They were developed
+late one night, just to test out sdbm, and convert some
+databases.
+
+
+
+
+
+
+
+
+
+                           - 4 -
+
+
+databases that insist in including the terminating null.
+
+     I have also included a copy of the dbe  (ndbm  DataBase
+Editor)  by  Janick Bergeron [janick@bnr.ca] for your pleas-
+ure. You may find it more useful than the little  dbu  util-
+ity.
+
+     dbm.[ch] is a dbm library emulation on top of ndbm (and
+hence suitable for sdbm). Written by Robert Elz.
+
+     The sdbm library has been around in beta test for quite
+a  long  time,  and from whatever little feedback I received
+(maybe no news is good news), I believe it  has  been  func-
+tioning  without  any  significant  problems.  I  would,  of
+course, appreciate all fixes and/or improvements.  Portabil-
+ity enhancements would especially be useful.
+
+Implementation Issues
+
+     Hash functions: The algorithm behind  sdbm  implementa-
+tion  needs a good bit-scrambling hash function to be effec-
+tive. I ran into a set of constants for a simple hash  func-
+tion  that  seem  to  help sdbm perform better than ndbm for
+various inputs:
+
+    /*
+     * polynomial conversion ignoring overflows
+     * 65599 nice. 65587 even better.
+     */
+    long
+    dbm_hash(char *str, int len) {
+        register unsigned long n = 0;
+
+        while (len--)
+            n = n * 65599 + *str++;
+        return n;
+    }
+
+     There may be better hash functions for the purposes  of
+dynamic hashing.  Try your favorite, and check the pagefile.
+If it contains too many pages with too many holes, (in rela-
+tion  to this one for example) or if sdbm simply stops work-
+ing (fails after SPLTMAX attempts to split)  when  you  feed
+your  NEWS  history  file  to it, you probably do not have a
+good hashing function.  If  you  do  better  (for  different
+types of input), I would like to know about the function you
+use.
+
+     Block sizes: It seems (from  various  tests  on  a  few
+machines)  that a page file block size PBLKSIZ of 1024 is by
+far the best for performance, but this also happens to limit
+the  size  of a key/value pair. Depending on your needs, you
+may wish to increase the page size, and also adjust  PAIRMAX
+(the maximum size of a key/value pair allowed: should always
+
+
+
+
+
+
+
+
+
+                           - 5 -
+
+
+be at least three words smaller than PBLKSIZ.)  accordingly.
+The  system-wide  version  of the library should probably be
+configured with 1024 (distribution default), as this appears
+to be sufficient for most common uses of sdbm.
+
+Portability
+
+     This package has been tested in many  different  UN*Xes
+even including minix, and appears to be reasonably portable.
+This does not mean it will port easily to non-UN*X systems.
+
+Notes and Miscellaneous
+
+     The sdbm is not a very complicated  package,  at  least
+not  after  you  familiarize yourself with the literature on
+external hashing. There are other interesting algorithms  in
+existence  that ensure (approximately) single-read access to
+a data value associated with any key. These  are  directory-
+less schemes such as linear hashing [Lit80] (+ Larson varia-
+tions), spiral storage [Mar79] or directory schemes such  as
+extensible  hashing  [Fag79] by Fagin et al. I do hope these
+sources provide a reasonable playground for  experimentation
+with  other algorithms.  See the June 1988 issue of ACM Com-
+puting Surveys [Enb88] for  an  excellent  overview  of  the
+field.
+
+References
+
+
+[Lar78]
+    P.-A. Larson, ``Dynamic Hashing'', BIT, vol.   18,   pp.
+    184-201, 1978.
+
+[Tho90]
+    Ken Thompson, private communication, Nov. 1990
+
+[Lit80]
+    W. Litwin, `` Linear Hashing: A new tool  for  file  and
+    table addressing'', Proceedings of the 6th Conference on
+    Very Large  Dabatases  (Montreal), pp.   212-223,   Very
+    Large Database Foundation, Saratoga, Calif., 1980.
+
+[Fag79]
+    R. Fagin, J.  Nievergelt,  N.  Pippinger,  and   H.   R.
+    Strong,  ``Extendible Hashing - A Fast Access Method for
+    Dynamic Files'', ACM  Trans.  Database  Syst.,  vol.  4,
+    no.3, pp. 315-344, Sept. 1979.
+
+[Wal84]
+    Rich Wales, ``Discussion of "dbm"  data  base  system'',
+    USENET newsgroup unix.wizards, Jan. 1984.
+
+[Tor87]
+    Chris Torek,  ``Re:   dbm.a   and   ndbm.a   archives'',
+
+
+
+
+
+
+
+
+
+                           - 6 -
+
+
+    USENET newsgroup comp.unix, 1987.
+
+[Mar79]
+    G. N. Martin, ``Spiral Storage: Incrementally   Augment-
+    able   Hash  Addressed  Storage'', Technical Report #27,
+    University of Varwick, Coventry, U.K., 1979.
+
+[Enb88]
+    R.  J.  Enbody  and  H.   C.   Du,   ``Dynamic   Hashing
+    Schemes'',ACM  Computing  Surveys,  vol.  20, no. 2, pp.
+    85-113, June 1988.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/contrib/perl5/ext/SDBM_File/sdbm/README.too b/contrib/perl5/ext/SDBM_File/sdbm/README.too
new file mode 100644
index 0000000..c2d0959
--- /dev/null
+++ b/contrib/perl5/ext/SDBM_File/sdbm/README.too
@@ -0,0 +1,9 @@
+This version of sdbm merely has all the dbm_* names translated to sdbm_*
+so that we can link ndbm and sdbm into the same executable.  (It also has
+the bad() macro redefined to allow a zero-length key.)
+
+
+Fri Apr 15 10:15:30 EDT 1994.
+
+Additional portability/configuration changes for libsdbm by Andy Dougherty
+doughera@lafcol.lafayette.edu.
diff --git a/contrib/perl5/ext/SDBM_File/sdbm/biblio b/contrib/perl5/ext/SDBM_File/sdbm/biblio
new file mode 100644
index 0000000..0be09fa
--- /dev/null
+++ b/contrib/perl5/ext/SDBM_File/sdbm/biblio
@@ -0,0 +1,64 @@
+%A R. J. Enbody
+%A H. C. Du
+%T Dynamic Hashing Schemes
+%J ACM Computing Surveys
+%V 20
+%N 2
+%D June 1988
+%P 85-113
+%K surveys
+
+%A P.-A. Larson
+%T Dynamic Hashing
+%J BIT
+%V 18
+%P 184-201
+%D 1978
+%K dynamic
+
+%A W. Litwin
+%T Linear Hashing: A new tool for file and table addressing
+%J Proceedings of the 6th Conference on Very Large Dabatases (Montreal)
+%I Very Large Database Foundation
+%C Saratoga, Calif.
+%P 212-223
+%D 1980
+%K linear
+
+%A R. Fagin
+%A J. Nievergelt
+%A N. Pippinger
+%A H. R. Strong
+%T Extendible Hashing - A Fast Access Method for Dynamic Files
+%J ACM Trans. Database Syst.
+%V 4
+%N 3
+%D Sept. 1979
+%P 315-344
+%K extend
+
+%A G. N. Martin
+%T Spiral Storage: Incrementally Augmentable Hash Addressed Storage
+%J Technical Report #27
+%I University of Varwick
+%C Coventry, U.K.
+%D 1979
+%K spiral
+
+%A Chris Torek
+%T Re: dbm.a and ndbm.a archives
+%B USENET newsgroup comp.unix
+%D 1987
+%K torek
+
+%A Rich Wales
+%T Discusson of "dbm" data base system
+%B USENET newsgroup unix.wizards
+%D Jan. 1984
+%K rich
+
+
+
+
+
+
diff --git a/contrib/perl5/ext/SDBM_File/sdbm/dba.c b/contrib/perl5/ext/SDBM_File/sdbm/dba.c
new file mode 100644
index 0000000..05e70c8
--- /dev/null
+++ b/contrib/perl5/ext/SDBM_File/sdbm/dba.c
@@ -0,0 +1,85 @@
+/*
+ * dba	dbm analysis/recovery
+ */
+
+#include <stdio.h>
+#include <sys/file.h>
+#include "EXTERN.h"
+#include "sdbm.h"
+
+char *progname;
+extern void oops();
+
+int
+main(argc, argv)
+char **argv;
+{
+	int n;
+	char *p;
+	char *name;
+	int pagf;
+
+	progname = argv[0];
+
+	if (p = argv[1]) {
+		name = (char *) malloc((n = strlen(p)) + 5);
+		strcpy(name, p);
+		strcpy(name + n, ".pag");
+
+		if ((pagf = open(name, O_RDONLY)) < 0)
+			oops("cannot open %s.", name);
+
+		sdump(pagf);
+	}
+	else
+		oops("usage: %s dbname", progname);
+
+	return 0;
+}
+
+sdump(pagf)
+int pagf;
+{
+	register b;
+	register n = 0;
+	register t = 0;
+	register o = 0;
+	register e;
+	char pag[PBLKSIZ];
+
+	while ((b = read(pagf, pag, PBLKSIZ)) > 0) {
+		printf("#%d: ", n);
+		if (!okpage(pag))
+			printf("bad\n");
+		else {
+			printf("ok. ");
+			if (!(e = pagestat(pag)))
+			    o++;
+			else
+			    t += e;
+		}
+		n++;
+	}
+
+	if (b == 0)
+		printf("%d pages (%d holes):  %d entries\n", n, o, t);
+	else
+		oops("read failed: block %d", n);
+}
+
+pagestat(pag)
+char *pag;
+{
+	register n;
+	register free;
+	register short *ino = (short *) pag;
+
+	if (!(n = ino[0]))
+		printf("no entries.\n");
+	else {
+		free = ino[n] - (n + 1) * sizeof(short);
+		printf("%3d entries %2d%% used free %d.\n",
+		       n / 2, ((PBLKSIZ - free) * 100) / PBLKSIZ, free);
+	}
+	return n / 2;
+}
diff --git a/contrib/perl5/ext/SDBM_File/sdbm/dbd.c b/contrib/perl5/ext/SDBM_File/sdbm/dbd.c
new file mode 100644
index 0000000..04ab842
--- /dev/null
+++ b/contrib/perl5/ext/SDBM_File/sdbm/dbd.c
@@ -0,0 +1,111 @@
+/*
+ * dbd - dump a dbm data file
+ */
+
+#include <stdio.h>
+#include <sys/file.h>
+#include "EXTERN.h"
+#include "sdbm.h"
+
+char *progname;
+extern void oops();
+
+
+#define empty(page)	(((short *) page)[0] == 0)
+
+int
+main(argc, argv)
+char **argv;
+{
+	int n;
+	char *p;
+	char *name;
+	int pagf;
+
+	progname = argv[0];
+
+	if (p = argv[1]) {
+		name = (char *) malloc((n = strlen(p)) + 5);
+		strcpy(name, p);
+		strcpy(name + n, ".pag");
+
+		if ((pagf = open(name, O_RDONLY)) < 0)
+			oops("cannot open %s.", name);
+
+		sdump(pagf);
+	}
+	else
+		oops("usage: %s dbname", progname);
+	return 0;
+}
+
+sdump(pagf)
+int pagf;
+{
+	register r;
+	register n = 0;
+	register o = 0;
+	char pag[PBLKSIZ];
+
+	while ((r = read(pagf, pag, PBLKSIZ)) > 0) {
+		if (!okpage(pag))
+			fprintf(stderr, "%d: bad page.\n", n);
+		else if (empty(pag))
+			o++;
+		else
+			dispage(pag);
+		n++;
+	}
+
+	if (r == 0)
+		fprintf(stderr, "%d pages (%d holes).\n", n, o);
+	else
+		oops("read failed: block %d", n);
+}
+
+
+#ifdef OLD
+dispage(pag)
+char *pag;
+{
+	register i, n;
+	register off;
+	register short *ino = (short *) pag;
+
+	off = PBLKSIZ;
+	for (i = 1; i < ino[0]; i += 2) {
+		printf("\t[%d]: ", ino[i]);
+		for (n = ino[i]; n < off; n++)
+			putchar(pag[n]);
+		putchar(' ');
+		off = ino[i];
+		printf("[%d]: ", ino[i + 1]);
+		for (n = ino[i + 1]; n < off; n++)
+			putchar(pag[n]);
+		off = ino[i + 1];
+		putchar('\n');
+	}
+}
+#else
+dispage(pag)
+char *pag;
+{
+	register i, n;
+	register off;
+	register short *ino = (short *) pag;
+
+	off = PBLKSIZ;
+	for (i = 1; i < ino[0]; i += 2) {
+		for (n = ino[i]; n < off; n++)
+			if (pag[n] != 0)
+				putchar(pag[n]);
+		putchar('\t');
+		off = ino[i];
+		for (n = ino[i + 1]; n < off; n++)
+			if (pag[n] != 0)
+				putchar(pag[n]);
+		putchar('\n');
+		off = ino[i + 1];
+	}
+}
+#endif
diff --git a/contrib/perl5/ext/SDBM_File/sdbm/dbe.1 b/contrib/perl5/ext/SDBM_File/sdbm/dbe.1
new file mode 100644
index 0000000..3b32272
--- /dev/null
+++ b/contrib/perl5/ext/SDBM_File/sdbm/dbe.1
@@ -0,0 +1,46 @@
+.TH dbe 1 "ndbm(3) EDITOR"
+.SH NAME
+dbe \- Edit a ndbm(3) database
+.SH USAGE
+dbe <database> [-m r|w|rw] [-crtvx] -a|-d|-f|-F|-s [<key> [<content>]]
+.SH DESCRIPTION
+\fIdbme\fP operates on ndbm(3) databases.
+It can be used to create them, look at them or change them.
+When specifying the value of a key or the content of its associated entry,
+\\nnn, \\0, \\n, \\t, \\f and \\r are interpreted as usual.
+When displaying key/content pairs, non-printable characters are displayed
+using the \\nnn notation.
+.SH OPTIONS
+.IP -a
+List all entries in the database.
+.IP -c
+Create the database if it does not exist.
+.IP -d
+Delete the entry associated with the specified key.
+.IP -f
+Fetch and display the entry associated with the specified key.
+.IP -F
+Fetch and display all the entries whose key match the specified
+regular-expression
+.IP "-m r|w|rw"
+Open the database in read-only, write-only or read-write mode
+.IP -r
+Replace the entry associated with the specified key if it already exists.
+See option -s.
+.IP -s
+Store an entry under a specific key.
+An error occurs if the key already exists and the option -r was not specified.
+.IP -t
+Re-initialize the database before executing the command.
+.IP -v
+Verbose mode.
+Confirm stores and deletions.
+.IP -x
+If option -x is used with option -c, then if the database already exists,
+an error occurs.
+This can be used to implement a simple exclusive access locking mechanism.
+.SH SEE ALSO
+ndbm(3)
+.SH AUTHOR
+janick@bnr.ca
+
diff --git a/contrib/perl5/ext/SDBM_File/sdbm/dbe.c b/contrib/perl5/ext/SDBM_File/sdbm/dbe.c
new file mode 100644
index 0000000..2a306f2
--- /dev/null
+++ b/contrib/perl5/ext/SDBM_File/sdbm/dbe.c
@@ -0,0 +1,435 @@
+#include <stdio.h>
+#ifndef VMS
+#include <sys/file.h>
+#include <ndbm.h>
+#else
+#include "file.h"
+#include "ndbm.h"
+#endif
+#include <ctype.h>
+
+/***************************************************************************\
+**                                                                         **
+**   Function name: getopt()                                               **
+**   Author:        Henry Spencer, UofT                                    **
+**   Coding date:   84/04/28                                               **
+**                                                                         **
+**   Description:                                                          **
+**                                                                         **
+**   Parses argv[] for arguments.                                          **
+**   Works with Whitesmith's C compiler.                                   **
+**                                                                         **
+**   Inputs   - The number of arguments                                    **
+**            - The base address of the array of arguments                 **
+**            - A string listing the valid options (':' indicates an       **
+**              argument to the preceding option is required, a ';'        **
+**              indicates an argument to the preceding option is optional) **
+**                                                                         **
+**   Outputs  - Returns the next option character,                         **
+**              '?' for non '-' arguments                                  **
+**              or ':' when there is no more arguments.                    **
+**                                                                         **
+**   Side Effects + The argument to an option is pointed to by 'optarg'    **
+**                                                                         **
+*****************************************************************************
+**                                                                         **
+**   REVISION HISTORY:                                                     **
+**                                                                         **
+**     DATE           NAME                        DESCRIPTION              **
+**   YY/MM/DD  ------------------   ------------------------------------   **
+**   88/10/20  Janick Bergeron      Returns '?' on unamed arguments        **
+**                                  returns '!' on unknown options         **
+**                                  and 'EOF' only when exhausted.         **
+**   88/11/18  Janick Bergeron      Return ':' when no more arguments      **
+**   89/08/11  Janick Bergeron      Optional optarg when ';' in optstring  **
+**                                                                         **
+\***************************************************************************/
+
+char *optarg;			       /* Global argument pointer. */
+
+#ifdef VMS
+#define index  strchr
+#endif
+
+char
+getopt(argc, argv, optstring)
+int argc;
+char **argv;
+char *optstring;
+{
+	register int c;
+	register char *place;
+	extern char *index();
+	static int optind = 0;
+	static char *scan = NULL;
+
+	optarg = NULL;
+
+	if (scan == NULL || *scan == '\0') {
+
+		if (optind == 0)
+			optind++;
+		if (optind >= argc)
+			return ':';
+
+		optarg = place = argv[optind++];
+		if (place[0] != '-' || place[1] == '\0')
+			return '?';
+		if (place[1] == '-' && place[2] == '\0')
+			return '?';
+		scan = place + 1;
+	}
+
+	c = *scan++;
+	place = index(optstring, c);
+	if (place == NULL || c == ':' || c == ';') {
+
+		(void) fprintf(stderr, "%s: unknown option %c\n", argv[0], c);
+		scan = NULL;
+		return '!';
+	}
+	if (*++place == ':') {
+
+		if (*scan != '\0') {
+
+			optarg = scan;
+			scan = NULL;
+
+		}
+		else {
+
+			if (optind >= argc) {
+
+				(void) fprintf(stderr, "%s: %c requires an argument\n",
+					       argv[0], c);
+				return '!';
+			}
+			optarg = argv[optind];
+			optind++;
+		}
+	}
+	else if (*place == ';') {
+
+		if (*scan != '\0') {
+
+			optarg = scan;
+			scan = NULL;
+
+		}
+		else {
+
+			if (optind >= argc || *argv[optind] == '-')
+				optarg = NULL;
+			else {
+				optarg = argv[optind];
+				optind++;
+			}
+		}
+	}
+	return c;
+}
+
+
+void
+print_datum(db)
+datum db;
+{
+	int i;
+
+	putchar('"');
+	for (i = 0; i < db.dsize; i++) {
+		if (isprint(db.dptr[i]))
+			putchar(db.dptr[i]);
+		else {
+			putchar('\\');
+			putchar('0' + ((db.dptr[i] >> 6) & 0x07));
+			putchar('0' + ((db.dptr[i] >> 3) & 0x07));
+			putchar('0' + (db.dptr[i] & 0x07));
+		}
+	}
+	putchar('"');
+}
+
+
+datum
+read_datum(s)
+char *s;
+{
+	datum db;
+	char *p;
+	int i;
+
+	db.dsize = 0;
+	db.dptr = (char *) malloc(strlen(s) * sizeof(char));
+	for (p = db.dptr; *s != '\0'; p++, db.dsize++, s++) {
+		if (*s == '\\') {
+			if (*++s == 'n')
+				*p = '\n';
+			else if (*s == 'r')
+				*p = '\r';
+			else if (*s == 'f')
+				*p = '\f';
+			else if (*s == 't')
+				*p = '\t';
+			else if (isdigit(*s) && isdigit(*(s + 1)) && isdigit(*(s + 2))) {
+				i = (*s++ - '0') << 6;
+				i |= (*s++ - '0') << 3;
+				i |= *s - '0';
+				*p = i;
+			}
+			else if (*s == '0')
+				*p = '\0';
+			else
+				*p = *s;
+		}
+		else
+			*p = *s;
+	}
+
+	return db;
+}
+
+
+char *
+key2s(db)
+datum db;
+{
+	char *buf;
+	char *p1, *p2;
+
+	buf = (char *) malloc((db.dsize + 1) * sizeof(char));
+	for (p1 = buf, p2 = db.dptr; *p2 != '\0'; *p1++ = *p2++);
+	*p1 = '\0';
+	return buf;
+}
+
+
+main(argc, argv)
+int argc;
+char **argv;
+{
+	typedef enum {
+		YOW, FETCH, STORE, DELETE, SCAN, REGEXP
+	} commands;
+	char opt;
+	int flags;
+	int giveusage = 0;
+	int verbose = 0;
+	commands what = YOW;
+	char *comarg[3];
+	int st_flag = DBM_INSERT;
+	int argn;
+	DBM *db;
+	datum key;
+	datum content;
+
+	flags = O_RDWR;
+	argn = 0;
+
+	while ((opt = getopt(argc, argv, "acdfFm:rstvx")) != ':') {
+		switch (opt) {
+		case 'a':
+			what = SCAN;
+			break;
+		case 'c':
+			flags |= O_CREAT;
+			break;
+		case 'd':
+			what = DELETE;
+			break;
+		case 'f':
+			what = FETCH;
+			break;
+		case 'F':
+			what = REGEXP;
+			break;
+		case 'm':
+			flags &= ~(000007);
+			if (strcmp(optarg, "r") == 0)
+				flags |= O_RDONLY;
+			else if (strcmp(optarg, "w") == 0)
+				flags |= O_WRONLY;
+			else if (strcmp(optarg, "rw") == 0)
+				flags |= O_RDWR;
+			else {
+				fprintf(stderr, "Invalid mode: \"%s\"\n", optarg);
+				giveusage = 1;
+			}
+			break;
+		case 'r':
+			st_flag = DBM_REPLACE;
+			break;
+		case 's':
+			what = STORE;
+			break;
+		case 't':
+			flags |= O_TRUNC;
+			break;
+		case 'v':
+			verbose = 1;
+			break;
+		case 'x':
+			flags |= O_EXCL;
+			break;
+		case '!':
+			giveusage = 1;
+			break;
+		case '?':
+			if (argn < 3)
+				comarg[argn++] = optarg;
+			else {
+				fprintf(stderr, "Too many arguments.\n");
+				giveusage = 1;
+			}
+			break;
+		}
+	}
+
+	if (giveusage | what == YOW | argn < 1) {
+		fprintf(stderr, "Usage: %s databse [-m r|w|rw] [-crtx] -a|-d|-f|-F|-s [key [content]]\n", argv[0]);
+		exit(-1);
+	}
+
+	if ((db = dbm_open(comarg[0], flags, 0777)) == NULL) {
+		fprintf(stderr, "Error opening database \"%s\"\n", comarg[0]);
+		exit(-1);
+	}
+
+	if (argn > 1)
+		key = read_datum(comarg[1]);
+	if (argn > 2)
+		content = read_datum(comarg[2]);
+
+	switch (what) {
+
+	case SCAN:
+		key = dbm_firstkey(db);
+		if (dbm_error(db)) {
+			fprintf(stderr, "Error when fetching first key\n");
+			goto db_exit;
+		}
+		while (key.dptr != NULL) {
+			content = dbm_fetch(db, key);
+			if (dbm_error(db)) {
+				fprintf(stderr, "Error when fetching ");
+				print_datum(key);
+				printf("\n");
+				goto db_exit;
+			}
+			print_datum(key);
+			printf(": ");
+			print_datum(content);
+			printf("\n");
+			if (dbm_error(db)) {
+				fprintf(stderr, "Error when fetching next key\n");
+				goto db_exit;
+			}
+			key = dbm_nextkey(db);
+		}
+		break;
+
+	case REGEXP:
+		if (argn < 2) {
+			fprintf(stderr, "Missing regular expression.\n");
+			goto db_exit;
+		}
+		if (re_comp(comarg[1])) {
+			fprintf(stderr, "Invalid regular expression\n");
+			goto db_exit;
+		}
+		key = dbm_firstkey(db);
+		if (dbm_error(db)) {
+			fprintf(stderr, "Error when fetching first key\n");
+			goto db_exit;
+		}
+		while (key.dptr != NULL) {
+			if (re_exec(key2s(key))) {
+				content = dbm_fetch(db, key);
+				if (dbm_error(db)) {
+					fprintf(stderr, "Error when fetching ");
+					print_datum(key);
+					printf("\n");
+					goto db_exit;
+				}
+				print_datum(key);
+				printf(": ");
+				print_datum(content);
+				printf("\n");
+				if (dbm_error(db)) {
+					fprintf(stderr, "Error when fetching next key\n");
+					goto db_exit;
+				}
+			}
+			key = dbm_nextkey(db);
+		}
+		break;
+
+	case FETCH:
+		if (argn < 2) {
+			fprintf(stderr, "Missing fetch key.\n");
+			goto db_exit;
+		}
+		content = dbm_fetch(db, key);
+		if (dbm_error(db)) {
+			fprintf(stderr, "Error when fetching ");
+			print_datum(key);
+			printf("\n");
+			goto db_exit;
+		}
+		if (content.dptr == NULL) {
+			fprintf(stderr, "Cannot find ");
+			print_datum(key);
+			printf("\n");
+			goto db_exit;
+		}
+		print_datum(key);
+		printf(": ");
+		print_datum(content);
+		printf("\n");
+		break;
+
+	case DELETE:
+		if (argn < 2) {
+			fprintf(stderr, "Missing delete key.\n");
+			goto db_exit;
+		}
+		if (dbm_delete(db, key) || dbm_error(db)) {
+			fprintf(stderr, "Error when deleting ");
+			print_datum(key);
+			printf("\n");
+			goto db_exit;
+		}
+		if (verbose) {
+			print_datum(key);
+			printf(": DELETED\n");
+		}
+		break;
+
+	case STORE:
+		if (argn < 3) {
+			fprintf(stderr, "Missing key and/or content.\n");
+			goto db_exit;
+		}
+		if (dbm_store(db, key, content, st_flag) || dbm_error(db)) {
+			fprintf(stderr, "Error when storing ");
+			print_datum(key);
+			printf("\n");
+			goto db_exit;
+		}
+		if (verbose) {
+			print_datum(key);
+			printf(": ");
+			print_datum(content);
+			printf(" STORED\n");
+		}
+		break;
+	}
+
+db_exit:
+	dbm_clearerr(db);
+	dbm_close(db);
+	if (dbm_error(db)) {
+		fprintf(stderr, "Error closing database \"%s\"\n", comarg[0]);
+		exit(-1);
+	}
+}
diff --git a/contrib/perl5/ext/SDBM_File/sdbm/dbm.c b/contrib/perl5/ext/SDBM_File/sdbm/dbm.c
new file mode 100644
index 0000000..1388230
--- /dev/null
+++ b/contrib/perl5/ext/SDBM_File/sdbm/dbm.c
@@ -0,0 +1,120 @@
+/*
+ * Copyright (c) 1985 The Regents of the University of California.
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms are permitted
+ * provided that the above copyright notice and this paragraph are
+ * duplicated in all such forms and that any documentation,
+ * advertising materials, and other materials related to such
+ * distribution and use acknowledge that the software was developed
+ * by the University of California, Berkeley.  The name of the
+ * University may not be used to endorse or promote products derived
+ * from this software without specific prior written permission.
+ * THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
+ * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
+ * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+ */
+
+#ifndef lint
+static char sccsid[] = "@(#)dbm.c    5.4 (Berkeley) 5/24/89";
+#endif /* not lint */
+
+#include    "dbm.h"
+
+#define    NODB    ((DBM *)0)
+
+static DBM *cur_db = NODB;
+
+static char no_db[] = "dbm: no open database\n";
+
+dbminit(file)
+    char *file;
+{
+    if (cur_db != NODB)
+        dbm_close(cur_db);
+
+    cur_db = dbm_open(file, 2, 0);
+    if (cur_db == NODB) {
+        cur_db = dbm_open(file, 0, 0);
+        if (cur_db == NODB)
+            return (-1);
+    }
+    return (0);
+}
+
+long
+forder(key)
+datum key;
+{
+    if (cur_db == NODB) {
+        printf(no_db);
+        return (0L);
+    }
+    return (dbm_forder(cur_db, key));
+}
+
+datum
+fetch(key)
+datum key;
+{
+    datum item;
+
+    if (cur_db == NODB) {
+        printf(no_db);
+        item.dptr = 0;
+        return (item);
+    }
+    return (dbm_fetch(cur_db, key));
+}
+
+delete(key)
+datum key;
+{
+    if (cur_db == NODB) {
+        printf(no_db);
+        return (-1);
+    }
+    if (dbm_rdonly(cur_db))
+        return (-1);
+    return (dbm_delete(cur_db, key));
+}
+
+store(key, dat)
+datum key, dat;
+{
+    if (cur_db == NODB) {
+        printf(no_db);
+        return (-1);
+    }
+    if (dbm_rdonly(cur_db))
+        return (-1);
+
+    return (dbm_store(cur_db, key, dat, DBM_REPLACE));
+}
+
+datum
+firstkey()
+{
+    datum item;
+
+    if (cur_db == NODB) {
+        printf(no_db);
+        item.dptr = 0;
+        return (item);
+    }
+    return (dbm_firstkey(cur_db));
+}
+
+datum
+nextkey(key)
+datum key;
+{
+    datum item;
+
+    if (cur_db == NODB) {
+        printf(no_db);
+        item.dptr = 0;
+        return (item);
+    }
+    return (dbm_nextkey(cur_db, key));
+}
diff --git a/contrib/perl5/ext/SDBM_File/sdbm/dbm.h b/contrib/perl5/ext/SDBM_File/sdbm/dbm.h
new file mode 100644
index 0000000..1196953
--- /dev/null
+++ b/contrib/perl5/ext/SDBM_File/sdbm/dbm.h
@@ -0,0 +1,35 @@
+/*
+ * Copyright (c) 1983 The Regents of the University of California.
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms are permitted
+ * provided that the above copyright notice and this paragraph are
+ * duplicated in all such forms and that any documentation,
+ * advertising materials, and other materials related to such
+ * distribution and use acknowledge that the software was developed
+ * by the University of California, Berkeley.  The name of the
+ * University may not be used to endorse or promote products derived
+ * from this software without specific prior written permission.
+ * THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
+ * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
+ * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+ *
+ *    @(#)dbm.h    5.2 (Berkeley) 5/24/89
+ */
+
+#ifndef NULL
+/*
+ * this is lunacy, we no longer use it (and never should have
+ * unconditionally defined it), but, this whole file is for
+ * backwards compatability - someone may rely on this.
+ */
+#define    NULL    ((char *) 0)
+#endif
+
+#ifdef I_NDBM
+# include <ndbm.h>
+#endif
+
+datum    fetch();
+datum    firstkey();
+datum    nextkey();
diff --git a/contrib/perl5/ext/SDBM_File/sdbm/dbu.c b/contrib/perl5/ext/SDBM_File/sdbm/dbu.c
new file mode 100644
index 0000000..a3c0004
--- /dev/null
+++ b/contrib/perl5/ext/SDBM_File/sdbm/dbu.c
@@ -0,0 +1,251 @@
+#include <stdio.h>
+#include <sys/file.h>
+#ifdef SDBM
+#include "EXTERN.h"
+#include "sdbm.h"
+#else
+#include <ndbm.h>
+#endif
+#include <string.h>
+
+#ifdef BSD42
+#define strchr	index
+#endif
+
+extern int	getopt();
+extern char	*strchr();
+extern void	oops();
+
+char *progname;
+
+static int rflag;
+static char *usage = "%s [-R] cat | look |... dbmname";
+
+#define DERROR	0
+#define DLOOK	1
+#define DINSERT	2
+#define DDELETE 3
+#define	DCAT	4
+#define DBUILD	5
+#define DPRESS	6
+#define DCREAT	7
+
+#define LINEMAX	8192
+
+typedef struct {
+	char *sname;
+	int scode;
+	int flags;
+} cmd;
+
+static cmd cmds[] = {
+
+	"fetch", DLOOK, 	O_RDONLY,
+	"get", DLOOK,		O_RDONLY,
+	"look", DLOOK,		O_RDONLY,
+	"add", DINSERT,		O_RDWR,
+	"insert", DINSERT,	O_RDWR,
+	"store", DINSERT,	O_RDWR,
+	"delete", DDELETE,	O_RDWR,
+	"remove", DDELETE,	O_RDWR,
+	"dump", DCAT,		O_RDONLY,
+	"list", DCAT, 		O_RDONLY,
+	"cat", DCAT,		O_RDONLY,
+	"creat", DCREAT,	O_RDWR | O_CREAT | O_TRUNC,
+	"new", DCREAT,		O_RDWR | O_CREAT | O_TRUNC,
+	"build", DBUILD,	O_RDWR | O_CREAT,
+	"squash", DPRESS,	O_RDWR,
+	"compact", DPRESS,	O_RDWR,
+	"compress", DPRESS,	O_RDWR
+};
+
+#define CTABSIZ (sizeof (cmds)/sizeof (cmd))
+
+static cmd *parse();
+static void badk(), doit(), prdatum();
+
+int
+main(argc, argv)
+int	argc;
+char *argv[];
+{
+	int c;
+	register cmd *act;
+	extern int optind;
+	extern char *optarg;
+
+	progname = argv[0];
+
+	while ((c = getopt(argc, argv, "R")) != EOF)
+		switch (c) {
+		case 'R':	       /* raw processing  */
+			rflag++;
+			break;
+
+		default:
+			oops("usage: %s", usage);
+			break;
+		}
+
+	if ((argc -= optind) < 2)
+		oops("usage: %s", usage);
+
+	if ((act = parse(argv[optind])) == NULL)
+		badk(argv[optind]);
+	optind++;
+	doit(act, argv[optind]);
+	return 0;
+}
+
+static void
+doit(act, file)
+register cmd *act;
+char *file;
+{
+	datum key;
+	datum val;
+	register DBM *db;
+	register char *op;
+	register int n;
+	char *line;
+#ifdef TIME
+	long start;
+	extern long time();
+#endif
+
+	if ((db = dbm_open(file, act->flags, 0644)) == NULL)
+		oops("cannot open: %s", file);
+
+	if ((line = (char *) malloc(LINEMAX)) == NULL)
+		oops("%s: cannot get memory", "line alloc");
+
+	switch (act->scode) {
+
+	case DLOOK:
+		while (fgets(line, LINEMAX, stdin) != NULL) {
+			n = strlen(line) - 1;
+			line[n] = 0;
+			key.dptr = line;
+			key.dsize = n;
+			val = dbm_fetch(db, key);
+			if (val.dptr != NULL) {
+				prdatum(stdout, val);
+				putchar('\n');
+				continue;
+			}
+			prdatum(stderr, key);
+			fprintf(stderr, ": not found.\n");
+		}
+		break;
+	case DINSERT:
+		break;
+	case DDELETE:
+		while (fgets(line, LINEMAX, stdin) != NULL) {
+			n = strlen(line) - 1;
+			line[n] = 0;
+			key.dptr = line;
+			key.dsize = n;
+			if (dbm_delete(db, key) == -1) {
+				prdatum(stderr, key);
+				fprintf(stderr, ": not found.\n");
+			}
+		}
+		break;
+	case DCAT:
+		for (key = dbm_firstkey(db); key.dptr != 0; 
+		     key = dbm_nextkey(db)) {
+			prdatum(stdout, key);
+			putchar('\t');
+			prdatum(stdout, dbm_fetch(db, key));
+			putchar('\n');
+		}
+		break;
+	case DBUILD:
+#ifdef TIME
+		start = time(0);
+#endif
+		while (fgets(line, LINEMAX, stdin) != NULL) {
+			n = strlen(line) - 1;
+			line[n] = 0;
+			key.dptr = line;
+			if ((op = strchr(line, '\t')) != 0) {
+				key.dsize = op - line;
+				*op++ = 0;
+				val.dptr = op;
+				val.dsize = line + n - op;
+			}
+			else
+				oops("bad input; %s", line);
+	
+			if (dbm_store(db, key, val, DBM_REPLACE) < 0) {
+				prdatum(stderr, key);
+				fprintf(stderr, ": ");
+				oops("store: %s", "failed");
+			}
+		}
+#ifdef TIME
+		printf("done: %d seconds.\n", time(0) - start);
+#endif
+		break;
+	case DPRESS:
+		break;
+	case DCREAT:
+		break;
+	}
+
+	dbm_close(db);
+}
+
+static void
+badk(word)
+char *word;
+{
+	register int i;
+
+	if (progname)
+		fprintf(stderr, "%s: ", progname);
+	fprintf(stderr, "bad keywd %s. use one of\n", word);
+	for (i = 0; i < (int)CTABSIZ; i++)
+		fprintf(stderr, "%-8s%c", cmds[i].sname,
+			((i + 1) % 6 == 0) ? '\n' : ' ');
+	fprintf(stderr, "\n");
+	exit(1);
+	/*NOTREACHED*/
+}
+
+static cmd *
+parse(str)
+register char *str;
+{
+	register int i = CTABSIZ;
+	register cmd *p;
+	
+	for (p = cmds; i--; p++)
+		if (strcmp(p->sname, str) == 0)
+			return p;
+	return NULL;
+}
+
+static void
+prdatum(stream, d)
+FILE *stream;
+datum d;
+{
+	register int c;
+	register char *p = d.dptr;
+	register int n = d.dsize;
+
+	while (n--) {
+		c = *p++ & 0377;
+		if (c & 0200) {
+			fprintf(stream, "M-");
+			c &= 0177;
+		}
+		if (c == 0177 || c < ' ') 
+			fprintf(stream, "^%c", (c == 0177) ? '?' : c + '@');
+		else
+			putc(c, stream);
+	}
+}
+
+
diff --git a/contrib/perl5/ext/SDBM_File/sdbm/grind b/contrib/perl5/ext/SDBM_File/sdbm/grind
new file mode 100755
index 0000000..23728b7
--- /dev/null
+++ b/contrib/perl5/ext/SDBM_File/sdbm/grind
@@ -0,0 +1,9 @@
+#!/bin/sh
+rm -f /tmp/*.dir /tmp/*.pag
+awk -e '{
+        printf "%s\t", $0
+        for (i = 0; i < 40; i++)
+                printf "%s.", $0
+        printf "\n"
+}' < /usr/dict/words | $1 build /tmp/$2
+
diff --git a/contrib/perl5/ext/SDBM_File/sdbm/hash.c b/contrib/perl5/ext/SDBM_File/sdbm/hash.c
new file mode 100644
index 0000000..9b27648
--- /dev/null
+++ b/contrib/perl5/ext/SDBM_File/sdbm/hash.c
@@ -0,0 +1,47 @@
+/*
+ * sdbm - ndbm work-alike hashed database library
+ * based on Per-Aake Larson's Dynamic Hashing algorithms. BIT 18 (1978).
+ * author: oz@nexus.yorku.ca
+ * status: public domain. keep it that way.
+ *
+ * hashing routine
+ */
+
+#include "config.h"
+#include "EXTERN.h"
+#include "sdbm.h"
+/*
+ * polynomial conversion ignoring overflows
+ * [this seems to work remarkably well, in fact better
+ * then the ndbm hash function. Replace at your own risk]
+ * use: 65599	nice.
+ *      65587   even better. 
+ */
+long
+sdbm_hash(register char *str, register int len)
+{
+	register unsigned long n = 0;
+
+#ifdef DUFF
+
+#define HASHC	n = *str++ + 65599 * n
+
+	if (len > 0) {
+		register int loop = (len + 8 - 1) >> 3;
+
+		switch(len & (8 - 1)) {
+		case 0:	do {
+			HASHC;	case 7:	HASHC;
+		case 6:	HASHC;	case 5:	HASHC;
+		case 4:	HASHC;	case 3:	HASHC;
+		case 2:	HASHC;	case 1:	HASHC;
+			} while (--loop);
+		}
+
+	}
+#else
+	while (len--)
+		n = *str++ + 65599 * n;
+#endif
+	return n;
+}
diff --git a/contrib/perl5/ext/SDBM_File/sdbm/linux.patches b/contrib/perl5/ext/SDBM_File/sdbm/linux.patches
new file mode 100644
index 0000000..cb7b1b7
--- /dev/null
+++ b/contrib/perl5/ext/SDBM_File/sdbm/linux.patches
@@ -0,0 +1,67 @@
+*** sdbm.dist/./dbu.c	Mon Feb 17 21:18:52 1992
+--- sdbm/./dbu.c	Mon Feb 17 21:11:20 1992
+***************
+*** 12,18 ****
+  #endif
+  
+  extern int	getopt();
+! extern char	*strchr();
+  extern void	oops();
+  
+  char *progname;
+--- 12,18 ----
+  #endif
+  
+  extern int	getopt();
+! /* extern char	*strchr(); */
+  extern void	oops();
+  
+  char *progname;
+*** sdbm.dist/./makefile	Mon Feb 17 21:18:56 1992
+--- sdbm/./makefile	Mon Feb 17 21:10:46 1992
+***************
+*** 2,8 ****
+  # makefile for public domain ndbm-clone: sdbm
+  # DUFF: use duff's device (loop unroll) in parts of the code
+  #
+! CFLAGS = -O -DSDBM -DDUFF -DBSD42
+  #LDFLAGS = -p
+  
+  OBJS = sdbm.o pair.o hash.o
+--- 2,8 ----
+  # makefile for public domain ndbm-clone: sdbm
+  # DUFF: use duff's device (loop unroll) in parts of the code
+  #
+! CFLAGS = -O -DSDBM -DDUFF
+  #LDFLAGS = -p
+  
+  OBJS = sdbm.o pair.o hash.o
+*** sdbm.dist/./sdbm.c	Mon Feb 17 21:19:17 1992
+--- sdbm/./sdbm.c	Mon Feb 17 21:12:59 1992
+***************
+*** 25,30 ****
+--- 25,31 ----
+  #endif
+  #include <errno.h>
+  #include <string.h>
++ #include <unistd.h>
+  
+  #ifdef __STDC__
+  #include <stddef.h>
+***************
+*** 43,49 ****
+  
+  extern char *malloc proto((unsigned int));
+  extern void free proto((void *));
+! extern long lseek();
+  
+  /*
+   * forward
+--- 44,50 ----
+  
+  extern char *malloc proto((unsigned int));
+  extern void free proto((void *));
+! /* extern long lseek(); */
+  
+  /*
+   * forward
diff --git a/contrib/perl5/ext/SDBM_File/sdbm/makefile.sdbm b/contrib/perl5/ext/SDBM_File/sdbm/makefile.sdbm
new file mode 100644
index 0000000..c959c1f
--- /dev/null
+++ b/contrib/perl5/ext/SDBM_File/sdbm/makefile.sdbm
@@ -0,0 +1,55 @@
+#
+# makefile for public domain ndbm-clone: sdbm
+# DUFF: use duff's device (loop unroll) in parts of the code
+#
+CFLAGS = -O -DSDBM -DDUFF -DBSD42 -pic
+#LDFLAGS = -p
+
+OBJS = sdbm.o pair.o hash.o
+SRCS = sdbm.c pair.c hash.c dbu.c dba.c dbd.c util.c
+HDRS = tune.h sdbm.h pair.h
+MISC = README CHANGES COMPARE sdbm.3 dbe.c dbe.1 dbm.c dbm.h biblio \
+       readme.ms readme.ps
+
+all: dbu dba dbd dbe
+
+dbu: dbu.o sdbm util.o
+	cc $(LDFLAGS) -o dbu dbu.o util.o libsdbm.a
+
+dba: dba.o util.o
+	cc $(LDFLAGS) -o dba dba.o util.o
+dbd: dbd.o util.o
+	cc $(LDFLAGS) -o dbd dbd.o util.o
+dbe: dbe.o sdbm
+	cc $(LDFLAGS) -o dbe dbe.o libsdbm.a
+
+sdbm: $(OBJS)
+	ar cr libsdbm.a $(OBJS)
+	ranlib libsdbm.a
+###	cp libsdbm.a /usr/lib/libsdbm.a
+
+dba.o: sdbm.h
+dbu.o: sdbm.h
+util.o:sdbm.h
+
+$(OBJS): sdbm.h tune.h pair.h
+
+#
+# dbu using berkelezoid ndbm routines [if you have them] for testing
+#
+#x-dbu: dbu.o util.o
+#	cc $(CFLAGS) -o x-dbu dbu.o util.o
+lint:
+	lint -abchx $(SRCS)
+
+clean:
+	rm -f *.o mon.out core
+
+purge: 	clean
+	rm -f dbu libsdbm.a dbd dba dbe x-dbu *.dir *.pag
+
+shar:
+	shar $(MISC) makefile $(SRCS) $(HDRS) >SDBM.SHAR
+
+readme:
+	nroff -ms readme.ms | col -b >README
diff --git a/contrib/perl5/ext/SDBM_File/sdbm/pair.c b/contrib/perl5/ext/SDBM_File/sdbm/pair.c
new file mode 100644
index 0000000..a9a805a
--- /dev/null
+++ b/contrib/perl5/ext/SDBM_File/sdbm/pair.c
@@ -0,0 +1,283 @@
+/*
+ * sdbm - ndbm work-alike hashed database library
+ * based on Per-Aake Larson's Dynamic Hashing algorithms. BIT 18 (1978).
+ * author: oz@nexus.yorku.ca
+ * status: public domain.
+ *
+ * page-level routines
+ */
+
+#include "config.h"
+#include "EXTERN.h"
+#include "sdbm.h"
+#include "tune.h"
+#include "pair.h"
+
+#define exhash(item)	sdbm_hash((item).dptr, (item).dsize)
+
+/* 
+ * forward 
+ */
+static int seepair proto((char *, int, char *, int));
+
+/*
+ * page format:
+ *	+------------------------------+
+ * ino	| n | keyoff | datoff | keyoff |
+ * 	+------------+--------+--------+
+ *	| datoff | - - - ---->	       |
+ *	+--------+---------------------+
+ *	|	 F R E E A R E A       |
+ *	+--------------+---------------+
+ *	|  <---- - - - | data          |
+ *	+--------+-----+----+----------+
+ *	|  key   | data     | key      |
+ *	+--------+----------+----------+
+ *
+ * calculating the offsets for free area:  if the number
+ * of entries (ino[0]) is zero, the offset to the END of
+ * the free area is the block size. Otherwise, it is the
+ * nth (ino[ino[0]]) entry's offset.
+ */
+
+int
+fitpair(char *pag, int need)
+{
+	register int n;
+	register int off;
+	register int free;
+	register short *ino = (short *) pag;
+
+	off = ((n = ino[0]) > 0) ? ino[n] : PBLKSIZ;
+	free = off - (n + 1) * sizeof(short);
+	need += 2 * sizeof(short);
+
+	debug(("free %d need %d\n", free, need));
+
+	return need <= free;
+}
+
+void
+putpair(char *pag, datum key, datum val)
+{
+	register int n;
+	register int off;
+	register short *ino = (short *) pag;
+
+	off = ((n = ino[0]) > 0) ? ino[n] : PBLKSIZ;
+/*
+ * enter the key first
+ */
+	off -= key.dsize;
+	(void) memcpy(pag + off, key.dptr, key.dsize);
+	ino[n + 1] = off;
+/*
+ * now the data
+ */
+	off -= val.dsize;
+	(void) memcpy(pag + off, val.dptr, val.dsize);
+	ino[n + 2] = off;
+/*
+ * adjust item count
+ */
+	ino[0] += 2;
+}
+
+datum
+getpair(char *pag, datum key)
+{
+	register int i;
+	register int n;
+	datum val;
+	register short *ino = (short *) pag;
+
+	if ((n = ino[0]) == 0)
+		return nullitem;
+
+	if ((i = seepair(pag, n, key.dptr, key.dsize)) == 0)
+		return nullitem;
+
+	val.dptr = pag + ino[i + 1];
+	val.dsize = ino[i] - ino[i + 1];
+	return val;
+}
+
+#ifdef SEEDUPS
+int
+duppair(char *pag, datum key)
+{
+	register short *ino = (short *) pag;
+	return ino[0] > 0 && seepair(pag, ino[0], key.dptr, key.dsize) > 0;
+}
+#endif
+
+datum
+getnkey(char *pag, int num)
+{
+	datum key;
+	register int off;
+	register short *ino = (short *) pag;
+
+	num = num * 2 - 1;
+	if (ino[0] == 0 || num > ino[0])
+		return nullitem;
+
+	off = (num > 1) ? ino[num - 1] : PBLKSIZ;
+
+	key.dptr = pag + ino[num];
+	key.dsize = off - ino[num];
+
+	return key;
+}
+
+int
+delpair(char *pag, datum key)
+{
+	register int n;
+	register int i;
+	register short *ino = (short *) pag;
+
+	if ((n = ino[0]) == 0)
+		return 0;
+
+	if ((i = seepair(pag, n, key.dptr, key.dsize)) == 0)
+		return 0;
+/*
+ * found the key. if it is the last entry
+ * [i.e. i == n - 1] we just adjust the entry count.
+ * hard case: move all data down onto the deleted pair,
+ * shift offsets onto deleted offsets, and adjust them.
+ * [note: 0 < i < n]
+ */
+	if (i < n - 1) {
+		register int m;
+		register char *dst = pag + (i == 1 ? PBLKSIZ : ino[i - 1]);
+		register char *src = pag + ino[i + 1];
+		register int   zoo = dst - src;
+
+		debug(("free-up %d ", zoo));
+/*
+ * shift data/keys down
+ */
+		m = ino[i + 1] - ino[n];
+#ifdef DUFF
+#define MOVB 	*--dst = *--src
+
+		if (m > 0) {
+			register int loop = (m + 8 - 1) >> 3;
+
+			switch (m & (8 - 1)) {
+			case 0:	do {
+				MOVB;	case 7:	MOVB;
+			case 6:	MOVB;	case 5:	MOVB;
+			case 4:	MOVB;	case 3:	MOVB;
+			case 2:	MOVB;	case 1:	MOVB;
+				} while (--loop);
+			}
+		}
+#else
+#ifdef HAS_MEMMOVE
+		dst -= m;
+		src -= m;
+		memmove(dst, src, m);
+#else
+		while (m--)
+			*--dst = *--src;
+#endif
+#endif
+/*
+ * adjust offset index up
+ */
+		while (i < n - 1) {
+			ino[i] = ino[i + 2] + zoo;
+			i++;
+		}
+	}
+	ino[0] -= 2;
+	return 1;
+}
+
+/*
+ * search for the key in the page.
+ * return offset index in the range 0 < i < n.
+ * return 0 if not found.
+ */
+static int
+seepair(char *pag, register int n, register char *key, register int siz)
+{
+	register int i;
+	register int off = PBLKSIZ;
+	register short *ino = (short *) pag;
+
+	for (i = 1; i < n; i += 2) {
+		if (siz == off - ino[i] &&
+		    memEQ(key, pag + ino[i], siz))
+			return i;
+		off = ino[i + 1];
+	}
+	return 0;
+}
+
+void
+splpage(char *pag, char *New, long int sbit)
+{
+	datum key;
+	datum val;
+
+	register int n;
+	register int off = PBLKSIZ;
+	char cur[PBLKSIZ];
+	register short *ino = (short *) cur;
+
+	(void) memcpy(cur, pag, PBLKSIZ);
+	(void) memset(pag, 0, PBLKSIZ);
+	(void) memset(New, 0, PBLKSIZ);
+
+	n = ino[0];
+	for (ino++; n > 0; ino += 2) {
+		key.dptr = cur + ino[0]; 
+		key.dsize = off - ino[0];
+		val.dptr = cur + ino[1];
+		val.dsize = ino[0] - ino[1];
+/*
+ * select the page pointer (by looking at sbit) and insert
+ */
+		(void) putpair((exhash(key) & sbit) ? New : pag, key, val);
+
+		off = ino[1];
+		n -= 2;
+	}
+
+	debug(("%d split %d/%d\n", ((short *) cur)[0] / 2, 
+	       ((short *) New)[0] / 2,
+	       ((short *) pag)[0] / 2));
+}
+
+/*
+ * check page sanity: 
+ * number of entries should be something
+ * reasonable, and all offsets in the index should be in order.
+ * this could be made more rigorous.
+ */
+int
+chkpage(char *pag)
+{
+	register int n;
+	register int off;
+	register short *ino = (short *) pag;
+
+	if ((n = ino[0]) < 0 || n > PBLKSIZ / sizeof(short))
+		return 0;
+
+	if (n > 0) {
+		off = PBLKSIZ;
+		for (ino++; n > 0; ino += 2) {
+			if (ino[0] > off || ino[1] > off ||
+			    ino[1] > ino[0])
+				return 0;
+			off = ino[1];
+			n -= 2;
+		}
+	}
+	return 1;
+}
diff --git a/contrib/perl5/ext/SDBM_File/sdbm/pair.h b/contrib/perl5/ext/SDBM_File/sdbm/pair.h
new file mode 100644
index 0000000..8a675b9
--- /dev/null
+++ b/contrib/perl5/ext/SDBM_File/sdbm/pair.h
@@ -0,0 +1,20 @@
+/* Mini EMBED (pair.c) */
+#define chkpage sdbm__chkpage
+#define delpair sdbm__delpair
+#define duppair sdbm__duppair
+#define fitpair sdbm__fitpair
+#define getnkey sdbm__getnkey
+#define getpair sdbm__getpair
+#define putpair sdbm__putpair
+#define splpage sdbm__splpage
+
+extern int fitpair proto((char *, int));
+extern void  putpair proto((char *, datum, datum));
+extern datum	getpair proto((char *, datum));
+extern int  delpair proto((char *, datum));
+extern int  chkpage proto((char *));
+extern datum getnkey proto((char *, int));
+extern void splpage proto((char *, char *, long));
+#ifdef SEEDUPS
+extern int duppair proto((char *, datum));
+#endif
diff --git a/contrib/perl5/ext/SDBM_File/sdbm/readme.ms b/contrib/perl5/ext/SDBM_File/sdbm/readme.ms
new file mode 100644
index 0000000..01ca17c
--- /dev/null
+++ b/contrib/perl5/ext/SDBM_File/sdbm/readme.ms
@@ -0,0 +1,353 @@
+.\" tbl | readme.ms | [tn]roff -ms | ...
+.\" note the "C" (courier) and "CB" fonts: you will probably have to
+.\" change these.
+.\" $Id: readme.ms,v 1.1 90/12/13 13:09:15 oz Exp Locker: oz $
+
+.de P1
+.br
+.nr dT 4
+.nf
+.ft C
+.sp .5
+.nr t \\n(dT*\\w'x'u
+.ta 1u*\\ntu 2u*\\ntu 3u*\\ntu 4u*\\ntu 5u*\\ntu 6u*\\ntu 7u*\\ntu 8u*\\ntu 9u*\\ntu 10u*\\ntu 11u*\\ntu 12u*\\ntu 13u*\\ntu 14u*\\ntu
+..
+.de P2
+.br
+.ft 1
+.br
+.sp .5
+.br
+.fi
+..
+.\" CW uses the typewriter/courier font.
+.de CW
+\fC\\$1\\fP\\$2
+..
+
+.\" Footnote numbering [by Henry Spencer]
+.\" <text>\*f for a footnote number..
+.\" .FS
+.\" \*F <footnote text>
+.\" .FE
+.\"
+.ds f \\u\\s-2\\n+f\\s+2\\d
+.nr f 0 1
+.ds F \\n+F.
+.nr F 0 1
+
+.ND
+.LP
+.TL
+\fIsdbm\fP \(em Substitute DBM
+.br
+or
+.br
+Berkeley \fIndbm\fP for Every UN*X\** Made Simple
+.AU
+Ozan (oz) Yigit
+.AI
+The Guild of PD Software Toolmakers
+Toronto - Canada
+.sp
+oz@nexus.yorku.ca
+.LP
+.FS
+UN*X is not a trademark of any (dis)organization.
+.FE
+.sp 2
+\fIImplementation is the sincerest form of flattery. \(em L. Peter Deutsch\fP
+.SH
+A The Clone of the \fIndbm\fP library
+.PP
+The sources accompanying this notice \(em \fIsdbm\fP \(em constitute
+the first public release (Dec. 1990) of a complete clone of
+the Berkeley UN*X \fIndbm\fP library. The \fIsdbm\fP library is meant to
+clone the proven functionality of \fIndbm\fP as closely as possible,
+including a few improvements. It is practical, easy to understand, and
+compatible.
+The \fIsdbm\fP library is not derived from any licensed, proprietary or
+copyrighted software.
+.PP
+The \fIsdbm\fP implementation is based on a 1978 algorithm
+[Lar78] by P.-A. (Paul) Larson known as ``Dynamic Hashing''.
+In the course of searching for a substitute for \fIndbm\fP, I
+prototyped three different external-hashing algorithms [Lar78, Fag79, Lit80]
+and ultimately chose Larson's algorithm as a basis of the \fIsdbm\fP
+implementation. The Bell Labs
+\fIdbm\fP (and therefore \fIndbm\fP) is based on an algorithm invented by
+Ken Thompson, [Tho90, Tor87] and predates Larson's work.
+.PP
+The \fIsdbm\fR programming interface is totally compatible
+with \fIndbm\fP and includes a slight improvement in database initialization.
+It is also expected to be binary-compatible under most UN*X versions that
+support the \fIndbm\fP library.
+.PP
+The \fIsdbm\fP implementation shares the shortcomings of the \fIndbm\fP
+library, as a side effect of various simplifications to the original Larson
+algorithm. It does produce \fIholes\fP in the page file as it writes
+pages past the end of file. (Larson's paper include a clever solution to
+this problem that is a result of using the hash value directly as a block
+address.) On the other hand, extensive tests seem to indicate that \fIsdbm\fP
+creates fewer holes in general, and the resulting pagefiles are
+smaller. The \fIsdbm\fP implementation is also faster than \fIndbm\fP
+in database creation.
+Unlike the \fIndbm\fP, the \fIsdbm\fP
+.CW store
+operation will not ``wander away'' trying to split its
+data pages to insert a datum that \fIcannot\fP (due to elaborate worst-case
+situations) be inserted. (It will fail after a pre-defined number of attempts.)
+.SH
+Important Compatibility Warning
+.PP
+The \fIsdbm\fP and \fIndbm\fP
+libraries \fIcannot\fP share databases: one cannot read the (dir/pag)
+database created by the other. This is due to the differences
+between the \fIndbm\fP and \fIsdbm\fP algorithms\**, 
+.FS
+Torek's discussion [Tor87]
+indicates that \fIdbm/ndbm\fP implementations use the hash
+value to traverse the radix trie differently than \fIsdbm\fP
+and as a result, the page indexes are generated in \fIdifferent\fP order.
+For more information, send e-mail to the author.
+.FE
+and the hash functions
+used.
+It is easy to convert between the \fIdbm/ndbm\fP databases and \fIsdbm\fP
+by ignoring the index completely: see
+.CW dbd ,
+.CW dbu
+etc.
+.R
+.LP
+.SH
+Notice of Intellectual Property
+.LP
+\fIThe entire\fP sdbm  \fIlibrary package, as authored by me,\fP Ozan S. Yigit,
+\fIis hereby placed in the public domain.\fP As such, the author is not
+responsible for the consequences of use of this software, no matter how
+awful, even if they arise from defects in it. There is no expressed or
+implied warranty for the \fIsdbm\fP library.
+.PP
+Since the \fIsdbm\fP
+library package is in the public domain, this \fIoriginal\fP
+release or any additional public-domain releases of the modified original
+cannot possibly (by definition) be withheld from you. Also by definition,
+You (singular) have all the rights to this code (including the right to
+sell without permission, the right to hoard\**
+.FS
+You cannot really hoard something that is available to the public at
+large, but try if it makes you feel any better.
+.FE
+and the right to do other icky things as
+you see fit) but those rights are also granted to everyone else.
+.PP
+Please note that all previous distributions of this software contained
+a copyright (which is now dropped) to protect its
+origins and its current public domain status against any possible claims
+and/or challenges.
+.SH
+Acknowledgments
+.PP
+Many people have been very helpful and supportive.  A partial list would
+necessarily include Rayan Zacherissen (who contributed the man page,
+and also hacked a MMAP version of \fIsdbm\fP),
+Arnold Robbins, Chris Lewis,
+Bill Davidsen, Henry Spencer, Geoff Collyer, Rich Salz (who got me started
+in the first place), Johannes Ruschein
+(who did the minix port) and David Tilbrook. I thank you all.
+.SH
+Distribution Manifest and Notes
+.LP
+This distribution of \fIsdbm\fP includes (at least) the following:
+.P1
+	CHANGES		change log
+	README		this file.
+	biblio		a small bibliography on external hashing
+	dba.c		a crude (n/s)dbm page file analyzer
+	dbd.c		a crude (n/s)dbm page file dumper (for conversion)
+	dbe.1		man page for dbe.c
+	dbe.c		Janick's database editor
+	dbm.c		a dbm library emulation wrapper for ndbm/sdbm
+	dbm.h		header file for the above
+	dbu.c		a crude db management utility
+	hash.c		hashing function
+	makefile	guess.
+	pair.c		page-level routines (posted earlier)
+	pair.h		header file for the above
+	readme.ms	troff source for the README file
+	sdbm.3		man page
+	sdbm.c		the real thing
+	sdbm.h		header file for the above
+	tune.h		place for tuning & portability thingies
+	util.c		miscellaneous
+.P2
+.PP
+.CW dbu
+is a simple database manipulation program\** that tries to look
+.FS
+The 
+.CW dbd ,
+.CW dba ,
+.CW dbu
+utilities are quick hacks and are not fit for production use. They were
+developed late one night, just to test out \fIsdbm\fP, and convert some
+databases.
+.FE
+like Bell Labs'
+.CW cbt
+utility. It is currently incomplete in functionality.
+I use
+.CW dbu
+to test out the routines: it takes (from stdin) tab separated
+key/value pairs for commands like
+.CW build
+or
+.CW insert
+or takes keys for
+commands like
+.CW delete
+or
+.CW look .
+.P1
+	dbu <build|creat|look|insert|cat|delete> dbmfile
+.P2
+.PP
+.CW dba
+is a crude analyzer of \fIdbm/sdbm/ndbm\fP
+page files. It scans the entire
+page file, reporting page level statistics, and totals at the end.
+.PP
+.CW dbd
+is a crude dump program for \fIdbm/ndbm/sdbm\fP
+databases. It ignores the
+bitmap, and dumps the data pages in sequence. It can be used to create
+input for the
+.CW dbu 
+utility.
+Note that
+.CW dbd
+will skip any NULLs in the key and data
+fields, thus is unsuitable to convert some peculiar databases that
+insist in including the terminating null.
+.PP
+I have also included a copy of the
+.CW dbe
+(\fIndbm\fP DataBase Editor) by Janick Bergeron [janick@bnr.ca] for
+your pleasure. You may find it more useful than the little
+.CW dbu
+utility.
+.PP
+.CW dbm.[ch]
+is a \fIdbm\fP library emulation on top of \fIndbm\fP
+(and hence suitable for \fIsdbm\fP). Written by Robert Elz.
+.PP
+The \fIsdbm\fP
+library has been around in beta test for quite a long time, and from whatever
+little feedback I received (maybe no news is good news), I believe it has been
+functioning without any significant problems. I would, of course, appreciate
+all fixes and/or improvements. Portability enhancements would especially be
+useful.
+.SH
+Implementation Issues
+.PP
+Hash functions:
+The algorithm behind \fIsdbm\fP implementation needs a good bit-scrambling
+hash function to be effective. I ran into a set of constants for a simple
+hash function that seem to help \fIsdbm\fP perform better than \fIndbm\fP
+for various inputs:
+.P1
+	/*
+	 * polynomial conversion ignoring overflows
+	 * 65599 nice. 65587 even better.
+	 */
+	long
+	dbm_hash(char *str, int len) {
+		register unsigned long n = 0;
+	
+		while (len--)
+			n = n * 65599 + *str++;
+		return n;
+	}
+.P2
+.PP
+There may be better hash functions for the purposes of dynamic hashing.
+Try your favorite, and check the pagefile. If it contains too many pages
+with too many holes, (in relation to this one for example) or if
+\fIsdbm\fP
+simply stops working (fails after 
+.CW SPLTMAX
+attempts to split) when you feed your
+NEWS 
+.CW history
+file to it, you probably do not have a good hashing function.
+If you do better (for different types of input), I would like to know
+about the function you use.
+.PP
+Block sizes: It seems (from various tests on a few machines) that a page
+file block size
+.CW PBLKSIZ
+of 1024 is by far the best for performance, but
+this also happens to limit the size of a key/value pair. Depending on your
+needs, you may wish to increase the page size, and also adjust
+.CW PAIRMAX
+(the maximum size of a key/value pair allowed: should always be at least
+three words smaller than
+.CW PBLKSIZ .)
+accordingly. The system-wide version of the library
+should probably be
+configured with 1024 (distribution default), as this appears to be sufficient
+for most common uses of \fIsdbm\fP.
+.SH
+Portability
+.PP
+This package has been tested in many different UN*Xes even including minix,
+and appears to be reasonably portable. This does not mean it will port
+easily to non-UN*X systems.
+.SH
+Notes and Miscellaneous
+.PP
+The \fIsdbm\fP is not a very complicated package, at least not after you
+familiarize yourself with the literature on external hashing. There are
+other interesting algorithms in existence that ensure (approximately)
+single-read access to a data value associated with any key. These are
+directory-less schemes such as \fIlinear hashing\fP [Lit80] (+ Larson
+variations), \fIspiral storage\fP [Mar79] or directory schemes such as
+\fIextensible hashing\fP [Fag79] by Fagin et al. I do hope these sources
+provide a reasonable playground for experimentation with other algorithms.
+See the June 1988 issue of ACM Computing Surveys [Enb88] for an
+excellent overview of the field. 
+.PG
+.SH
+References
+.LP
+.IP [Lar78] 4m
+P.-A. Larson,
+``Dynamic Hashing'', \fIBIT\fP, vol.  18,  pp. 184-201, 1978.
+.IP [Tho90] 4m
+Ken Thompson, \fIprivate communication\fP, Nov. 1990
+.IP [Lit80] 4m
+W. Litwin,
+`` Linear Hashing: A new tool  for  file  and table addressing'',
+\fIProceedings of the 6th Conference on Very Large  Dabatases  (Montreal)\fP,
+pp.  212-223,  Very Large Database Foundation, Saratoga, Calif., 1980.
+.IP [Fag79] 4m
+R. Fagin, J.  Nievergelt,  N.  Pippinger,  and  H.  R. Strong,
+``Extendible Hashing - A Fast Access Method for Dynamic Files'',
+\fIACM Trans. Database Syst.\fP, vol. 4,  no.3, pp. 315-344, Sept. 1979.
+.IP [Wal84] 4m
+Rich Wales,
+``Discussion of "dbm" data base system'', \fIUSENET newsgroup unix.wizards\fP,
+Jan. 1984.
+.IP [Tor87] 4m
+Chris Torek,
+``Re:  dbm.a  and  ndbm.a  archives'', \fIUSENET newsgroup comp.unix\fP,
+1987.
+.IP [Mar79] 4m
+G. N. Martin,
+``Spiral Storage: Incrementally  Augmentable  Hash  Addressed  Storage'',
+\fITechnical Report #27\fP, University of Varwick, Coventry, U.K., 1979.
+.IP [Enb88] 4m
+R. J. Enbody and H. C. Du,
+``Dynamic Hashing  Schemes'',\fIACM Computing Surveys\fP,
+vol. 20, no. 2, pp. 85-113, June 1988.
diff --git a/contrib/perl5/ext/SDBM_File/sdbm/sdbm.3 b/contrib/perl5/ext/SDBM_File/sdbm/sdbm.3
new file mode 100644
index 0000000..7e5c176
--- /dev/null
+++ b/contrib/perl5/ext/SDBM_File/sdbm/sdbm.3
@@ -0,0 +1,290 @@
+.\" $Id: sdbm.3,v 1.2 90/12/13 13:00:57 oz Exp $
+.TH SDBM 3 "1 March 1990"
+.SH NAME
+sdbm, sdbm_open, sdbm_prep, sdbm_close, sdbm_fetch, sdbm_store, sdbm_delete, sdbm_firstkey, sdbm_nextkey, sdbm_hash, sdbm_rdonly, sdbm_error, sdbm_clearerr, sdbm_dirfno, sdbm_pagfno \- data base subroutines
+.SH SYNOPSIS
+.nf
+.ft B
+#include <sdbm.h>
+.sp
+typedef struct {
+	char *dptr;
+	int dsize;
+} datum;
+.sp
+datum nullitem = { NULL, 0 };
+.sp
+\s-1DBM\s0 *sdbm_open(char *file, int flags, int mode)
+.sp
+\s-1DBM\s0 *sdbm_prep(char *dirname, char *pagname, int flags, int mode)
+.sp
+void sdbm_close(\s-1DBM\s0 *db)
+.sp
+datum sdbm_fetch(\s-1DBM\s0 *db, key)
+.sp
+int sdbm_store(\s-1DBM\s0 *db, datum key, datum val, int flags)
+.sp
+int sdbm_delete(\s-1DBM\s0 *db, datum key)
+.sp
+datum sdbm_firstkey(\s-1DBM\s0 *db)
+.sp
+datum sdbm_nextkey(\s-1DBM\s0 *db)
+.sp
+long sdbm_hash(char *string, int len)
+.sp
+int sdbm_rdonly(\s-1DBM\s0 *db)
+int sdbm_error(\s-1DBM\s0 *db)
+sdbm_clearerr(\s-1DBM\s0 *db)
+int sdbm_dirfno(\s-1DBM\s0 *db)
+int sdbm_pagfno(\s-1DBM\s0 *db)
+.ft R
+.fi
+.SH DESCRIPTION
+.IX "database library" sdbm "" "\fLsdbm\fR"
+.IX sdbm_open "" "\fLsdbm_open\fR \(em open \fLsdbm\fR database"
+.IX sdbm_prep "" "\fLsdbm_prep\fR \(em prepare \fLsdbm\fR database"
+.IX sdbm_close "" "\fLsdbm_close\fR \(em close \fLsdbm\fR routine"
+.IX sdbm_fetch "" "\fLsdbm_fetch\fR \(em fetch \fLsdbm\fR database data"
+.IX sdbm_store "" "\fLsdbm_store\fR \(em add data to \fLsdbm\fR database"
+.IX sdbm_delete "" "\fLsdbm_delete\fR \(em remove data from \fLsdbm\fR database"
+.IX sdbm_firstkey "" "\fLsdbm_firstkey\fR \(em access \fLsdbm\fR database"
+.IX sdbm_nextkey "" "\fLsdbm_nextkey\fR \(em access \fLsdbm\fR database"
+.IX sdbm_hash "" "\fLsdbm_hash\fR \(em string hash for \fLsdbm\fR database"
+.IX sdbm_rdonly "" "\fLsdbm_rdonly\fR \(em return \fLsdbm\fR database read-only mode"
+.IX sdbm_error "" "\fLsdbm_error\fR \(em return \fLsdbm\fR database error condition"
+.IX sdbm_clearerr "" "\fLsdbm_clearerr\fR \(em clear \fLsdbm\fR database error condition"
+.IX sdbm_dirfno "" "\fLsdbm_dirfno\fR \(em return \fLsdbm\fR database bitmap file descriptor"
+.IX sdbm_pagfno "" "\fLsdbm_pagfno\fR \(em return \fLsdbm\fR database data file descriptor"
+.IX "database functions \(em \fLsdbm\fR"  sdbm_open  ""  \fLsdbm_open\fP
+.IX "database functions \(em \fLsdbm\fR"  sdbm_prep  ""  \fLsdbm_prep\fP
+.IX "database functions \(em \fLsdbm\fR"  sdbm_close  ""  \fLsdbm_close\fP
+.IX "database functions \(em \fLsdbm\fR"  sdbm_fetch  ""  \fLsdbm_fetch\fP
+.IX "database functions \(em \fLsdbm\fR"  sdbm_store  ""  \fLsdbm_store\fP
+.IX "database functions \(em \fLsdbm\fR"  sdbm_delete  ""  \fLsdbm_delete\fP
+.IX "database functions \(em \fLsdbm\fR"  sdbm_firstkey  ""  \fLsdbm_firstkey\fP
+.IX "database functions \(em \fLsdbm\fR"  sdbm_nextkey  ""  \fLsdbm_nextkey\fP
+.IX "database functions \(em \fLsdbm\fR"  sdbm_rdonly  ""  \fLsdbm_rdonly\fP
+.IX "database functions \(em \fLsdbm\fR"  sdbm_error  ""  \fLsdbm_error\fP
+.IX "database functions \(em \fLsdbm\fR"  sdbm_clearerr  ""  \fLsdbm_clearerr\fP
+.IX "database functions \(em \fLsdbm\fR"  sdbm_dirfno  ""  \fLsdbm_dirfno\fP
+.IX "database functions \(em \fLsdbm\fR"  sdbm_pagfno  ""  \fLsdbm_pagfno\fP
+.LP
+This package allows an application to maintain a mapping of <key,value> pairs
+in disk files.  This is not to be considered a real database system, but is
+still useful in many simple applications built around fast retrieval of a data
+value from a key.  This implementation uses an external hashing scheme,
+called Dynamic Hashing, as described by Per-Aake Larson in BIT 18 (1978) pp.
+184-201.  Retrieval of any item usually requires a single disk access.
+The application interface is compatible with the
+.IR ndbm (3)
+library.
+.LP
+An
+.B sdbm
+database is kept in two files usually given the extensions
+.B \.dir
+and
+.BR \.pag .
+The
+.B \.dir
+file contains a bitmap representing a forest of binary hash trees, the leaves
+of which indicate data pages in the
+.B \.pag
+file.
+.LP
+The application interface uses the
+.B datum
+structure to describe both
+.I keys
+and
+.IR value s.
+A
+.B datum
+specifies a byte sequence of
+.I dsize
+size pointed to by
+.IR dptr .
+If you use
+.SM ASCII
+strings as
+.IR key s
+or
+.IR value s,
+then you must decide whether or not to include the terminating
+.SM NUL
+byte which sometimes defines strings.  Including it will require larger
+database files, but it will be possible to get sensible output from a
+.IR strings (1)
+command applied to the data file.
+.LP
+In order to allow a process using this package to manipulate multiple
+databases, the applications interface always requires a
+.IR handle ,
+a
+.BR "DBM *" ,
+to identify the database to be manipulated.  Such a handle can be obtained
+from the only routines that do not require it, namely
+.BR sdbm_open (\|)
+or
+.BR sdbm_prep (\|).
+Either of these will open or create the two necessary files.  The
+difference is that the latter allows explicitly naming the bitmap and data
+files whereas
+.BR sdbm_open (\|)
+will take a base file name and call
+.BR sdbm_prep (\|)
+with the default extensions.
+The
+.I flags
+and
+.I mode
+parameters are the same as for
+.BR open (2).
+.LP
+To free the resources occupied while a database handle is active, call
+.BR sdbm_close (\|).
+.LP
+Given a handle, one can retrieve data associated with a key by using the
+.BR sdbm_fetch (\|)
+routine, and associate data with a key by using the
+.BR sdbm_store (\|)
+routine.
+.LP
+The values of the
+.I flags
+parameter for
+.BR sdbm_store (\|)
+can be either
+.BR \s-1DBM_INSERT\s0 ,
+which will not change an existing entry with the same key, or
+.BR \s-1DBM_REPLACE\s0 ,
+which will replace an existing entry with the same key.
+Keys are unique within the database.
+.LP
+To delete a key and its associated value use the
+.BR sdbm_delete (\|)
+routine.
+.LP
+To retrieve every key in the database, use a loop like:
+.sp
+.nf
+.ft B
+for (key = sdbm_firstkey(db); key.dptr != NULL; key = sdbm_nextkey(db))
+        ;
+.ft R
+.fi
+.LP
+The order of retrieval is unspecified.
+.LP
+If you determine that the performance of the database is inadequate or
+you notice clustering or other effects that may be due to the hashing
+algorithm used by this package, you can override it by supplying your
+own
+.BR sdbm_hash (\|)
+routine.  Doing so will make the database unintelligable to any other
+applications that do not use your specialized hash function.
+.sp
+.LP
+The following macros are defined in the header file:
+.IP
+.BR sdbm_rdonly (\|)
+returns true if the database has been opened read\-only.
+.IP
+.BR sdbm_error (\|)
+returns true if an I/O error has occurred.
+.IP
+.BR sdbm_clearerr (\|)
+allows you to clear the error flag if you think you know what the error
+was and insist on ignoring it.
+.IP
+.BR sdbm_dirfno (\|)
+returns the file descriptor associated with the bitmap file.
+.IP
+.BR sdbm_pagfno (\|)
+returns the file descriptor associated with the data file.
+.SH SEE ALSO
+.IR open (2).
+.SH DIAGNOSTICS
+Functions that return a
+.B "DBM *"
+handle will use
+.SM NULL
+to indicate an error.
+Functions that return an
+.B int
+will use \-1 to indicate an error.  The normal return value in that case is 0.
+Functions that return a
+.B datum
+will return
+.B nullitem
+to indicate an error.
+.LP
+As a special case of
+.BR sdbm_store (\|),
+if it is called with the
+.B \s-1DBM_INSERT\s0
+flag and the key already exists in the database, the return value will be 1.
+.LP
+In general, if a function parameter is invalid,
+.B errno
+will be set to
+.BR \s-1EINVAL\s0 .
+If a write operation is requested on a read-only database,
+.B errno
+will be set to
+.BR \s-1ENOPERM\s0 .
+If a memory allocation (using
+.IR malloc (3))
+failed,
+.B errno
+will be set to
+.BR \s-1ENOMEM\s0 .
+For I/O operation failures
+.B errno
+will contain the value set by the relevant failed system call, either
+.IR read (2),
+.IR write (2),
+or
+.IR lseek (2).
+.SH AUTHOR
+.IP "Ozan S. Yigit" (oz@nexus.yorku.ca)
+.SH BUGS
+The sum of key and value data sizes must not exceed
+.B \s-1PAIRMAX\s0
+(1008 bytes).
+.LP
+The sum of the key and value data sizes where several keys hash to the
+same value must fit within one bitmap page.
+.LP
+The
+.B \.pag
+file will contain holes, so its apparent size is larger than its contents.
+When copied through the filesystem the holes will be filled.
+.LP
+The contents of
+.B datum
+values returned are in volatile storage.  If you want to retain the values
+pointed to, you must copy them immediately before another call to this package.
+.LP
+The only safe way for multiple processes to (read and) update a database at
+the same time, is to implement a private locking scheme outside this package
+and open and close the database between lock acquisitions.  It is safe for
+multiple processes to concurrently access a database read-only.
+.SH APPLICATIONS PORTABILITY
+For complete source code compatibility with the Berkeley Unix
+.IR ndbm (3)
+library, the 
+.B sdbm.h
+header file should be installed in
+.BR /usr/include/ndbm.h .
+.LP
+The
+.B nullitem
+data item, and the
+.BR sdbm_prep (\|),
+.BR sdbm_hash (\|),
+.BR sdbm_rdonly (\|),
+.BR sdbm_dirfno (\|),
+and
+.BR sdbm_pagfno (\|)
+functions are unique to this package.
diff --git a/contrib/perl5/ext/SDBM_File/sdbm/sdbm.c b/contrib/perl5/ext/SDBM_File/sdbm/sdbm.c
new file mode 100644
index 0000000..637fbe9
--- /dev/null
+++ b/contrib/perl5/ext/SDBM_File/sdbm/sdbm.c
@@ -0,0 +1,492 @@
+/*
+ * sdbm - ndbm work-alike hashed database library
+ * based on Per-Aake Larson's Dynamic Hashing algorithms. BIT 18 (1978).
+ * author: oz@nexus.yorku.ca
+ * status: public domain.
+ *
+ * core routines
+ */
+
+#include "INTERN.h"
+#include "config.h"
+#include "sdbm.h"
+#include "tune.h"
+#include "pair.h"
+
+#ifdef I_FCNTL
+# include <fcntl.h>
+#endif
+#ifdef I_SYS_FILE
+# include <sys/file.h>
+#endif
+
+#ifdef I_STRING
+# include <string.h>
+#else
+# include <strings.h>
+#endif
+
+/*
+ * externals
+ */
+#ifndef WIN32
+#ifndef sun
+extern int errno;
+#endif
+
+extern Malloc_t malloc proto((MEM_SIZE));
+extern Free_t free proto((Malloc_t));
+extern Off_t lseek(int, Off_t, int);
+#endif
+
+/*
+ * forward
+ */
+static int getdbit proto((DBM *, long));
+static int setdbit proto((DBM *, long));
+static int getpage proto((DBM *, long));
+static datum getnext proto((DBM *));
+static int makroom proto((DBM *, long, int));
+
+/*
+ * useful macros
+ */
+#define bad(x)		((x).dptr == NULL || (x).dsize < 0)
+#define exhash(item)	sdbm_hash((item).dptr, (item).dsize)
+#define ioerr(db)	((db)->flags |= DBM_IOERR)
+
+#define OFF_PAG(off)	(long) (off) * PBLKSIZ
+#define OFF_DIR(off)	(long) (off) * DBLKSIZ
+
+static long masks[] = {
+	000000000000, 000000000001, 000000000003, 000000000007,
+	000000000017, 000000000037, 000000000077, 000000000177,
+	000000000377, 000000000777, 000000001777, 000000003777,
+	000000007777, 000000017777, 000000037777, 000000077777,
+	000000177777, 000000377777, 000000777777, 000001777777,
+	000003777777, 000007777777, 000017777777, 000037777777,
+	000077777777, 000177777777, 000377777777, 000777777777,
+	001777777777, 003777777777, 007777777777, 017777777777
+};
+
+DBM *
+sdbm_open(register char *file, register int flags, register int mode)
+{
+	register DBM *db;
+	register char *dirname;
+	register char *pagname;
+	register int n;
+
+	if (file == NULL || !*file)
+		return errno = EINVAL, (DBM *) NULL;
+/*
+ * need space for two seperate filenames
+ */
+	n = strlen(file) * 2 + strlen(DIRFEXT) + strlen(PAGFEXT) + 2;
+
+	if ((dirname = (char *) malloc((unsigned) n)) == NULL)
+		return errno = ENOMEM, (DBM *) NULL;
+/*
+ * build the file names
+ */
+	dirname = strcat(strcpy(dirname, file), DIRFEXT);
+	pagname = strcpy(dirname + strlen(dirname) + 1, file);
+	pagname = strcat(pagname, PAGFEXT);
+
+	db = sdbm_prep(dirname, pagname, flags, mode);
+	free((char *) dirname);
+	return db;
+}
+
+DBM *
+sdbm_prep(char *dirname, char *pagname, int flags, int mode)
+{
+	register DBM *db;
+	struct stat dstat;
+
+	if ((db = (DBM *) malloc(sizeof(DBM))) == NULL)
+		return errno = ENOMEM, (DBM *) NULL;
+
+        db->flags = 0;
+        db->hmask = 0;
+        db->blkptr = 0;
+        db->keyptr = 0;
+/*
+ * adjust user flags so that WRONLY becomes RDWR, 
+ * as required by this package. Also set our internal
+ * flag for RDONLY if needed.
+ */
+	if (flags & O_WRONLY)
+		flags = (flags & ~O_WRONLY) | O_RDWR;
+
+	else if ((flags & 03) == O_RDONLY)
+		db->flags = DBM_RDONLY;
+/*
+ * open the files in sequence, and stat the dirfile.
+ * If we fail anywhere, undo everything, return NULL.
+ */
+#if defined(OS2) || defined(MSDOS) || defined(WIN32)
+	flags |= O_BINARY;
+#	endif
+	if ((db->pagf = open(pagname, flags, mode)) > -1) {
+		if ((db->dirf = open(dirname, flags, mode)) > -1) {
+/*
+ * need the dirfile size to establish max bit number.
+ */
+			if (fstat(db->dirf, &dstat) == 0) {
+/*
+ * zero size: either a fresh database, or one with a single,
+ * unsplit data page: dirpage is all zeros.
+ */
+				db->dirbno = (!dstat.st_size) ? 0 : -1;
+				db->pagbno = -1;
+				db->maxbno = dstat.st_size * BYTESIZ;
+
+				(void) memset(db->pagbuf, 0, PBLKSIZ);
+				(void) memset(db->dirbuf, 0, DBLKSIZ);
+			/*
+			 * success
+			 */
+				return db;
+			}
+			(void) close(db->dirf);
+		}
+		(void) close(db->pagf);
+	}
+	free((char *) db);
+	return (DBM *) NULL;
+}
+
+void
+sdbm_close(register DBM *db)
+{
+	if (db == NULL)
+		errno = EINVAL;
+	else {
+		(void) close(db->dirf);
+		(void) close(db->pagf);
+		free((char *) db);
+	}
+}
+
+datum
+sdbm_fetch(register DBM *db, datum key)
+{
+	if (db == NULL || bad(key))
+		return errno = EINVAL, nullitem;
+
+	if (getpage(db, exhash(key)))
+		return getpair(db->pagbuf, key);
+
+	return ioerr(db), nullitem;
+}
+
+int
+sdbm_delete(register DBM *db, datum key)
+{
+	if (db == NULL || bad(key))
+		return errno = EINVAL, -1;
+	if (sdbm_rdonly(db))
+		return errno = EPERM, -1;
+
+	if (getpage(db, exhash(key))) {
+		if (!delpair(db->pagbuf, key))
+			return -1;
+/*
+ * update the page file
+ */
+		if (lseek(db->pagf, OFF_PAG(db->pagbno), SEEK_SET) < 0
+		    || write(db->pagf, db->pagbuf, PBLKSIZ) < 0)
+			return ioerr(db), -1;
+
+		return 0;
+	}
+
+	return ioerr(db), -1;
+}
+
+int
+sdbm_store(register DBM *db, datum key, datum val, int flags)
+{
+	int need;
+	register long hash;
+
+	if (db == NULL || bad(key))
+		return errno = EINVAL, -1;
+	if (sdbm_rdonly(db))
+		return errno = EPERM, -1;
+
+	need = key.dsize + val.dsize;
+/*
+ * is the pair too big (or too small) for this database ??
+ */
+	if (need < 0 || need > PAIRMAX)
+		return errno = EINVAL, -1;
+
+	if (getpage(db, (hash = exhash(key)))) {
+/*
+ * if we need to replace, delete the key/data pair
+ * first. If it is not there, ignore.
+ */
+		if (flags == DBM_REPLACE)
+			(void) delpair(db->pagbuf, key);
+#ifdef SEEDUPS
+		else if (duppair(db->pagbuf, key))
+			return 1;
+#endif
+/*
+ * if we do not have enough room, we have to split.
+ */
+		if (!fitpair(db->pagbuf, need))
+			if (!makroom(db, hash, need))
+				return ioerr(db), -1;
+/*
+ * we have enough room or split is successful. insert the key,
+ * and update the page file.
+ */
+		(void) putpair(db->pagbuf, key, val);
+
+		if (lseek(db->pagf, OFF_PAG(db->pagbno), SEEK_SET) < 0
+		    || write(db->pagf, db->pagbuf, PBLKSIZ) < 0)
+			return ioerr(db), -1;
+	/*
+	 * success
+	 */
+		return 0;
+	}
+
+	return ioerr(db), -1;
+}
+
+/*
+ * makroom - make room by splitting the overfull page
+ * this routine will attempt to make room for SPLTMAX times before
+ * giving up.
+ */
+static int
+makroom(register DBM *db, long int hash, int need)
+{
+	long newp;
+	char twin[PBLKSIZ];
+	char *pag = db->pagbuf;
+	char *New = twin;
+	register int smax = SPLTMAX;
+
+	do {
+/*
+ * split the current page
+ */
+		(void) splpage(pag, New, db->hmask + 1);
+/*
+ * address of the new page
+ */
+		newp = (hash & db->hmask) | (db->hmask + 1);
+
+/*
+ * write delay, read avoidence/cache shuffle:
+ * select the page for incoming pair: if key is to go to the new page,
+ * write out the previous one, and copy the new one over, thus making
+ * it the current page. If not, simply write the new page, and we are
+ * still looking at the page of interest. current page is not updated
+ * here, as sdbm_store will do so, after it inserts the incoming pair.
+ */
+		if (hash & (db->hmask + 1)) {
+			if (lseek(db->pagf, OFF_PAG(db->pagbno), SEEK_SET) < 0
+			    || write(db->pagf, db->pagbuf, PBLKSIZ) < 0)
+				return 0;
+			db->pagbno = newp;
+			(void) memcpy(pag, New, PBLKSIZ);
+		}
+		else if (lseek(db->pagf, OFF_PAG(newp), SEEK_SET) < 0
+			 || write(db->pagf, New, PBLKSIZ) < 0)
+			return 0;
+
+		if (!setdbit(db, db->curbit))
+			return 0;
+/*
+ * see if we have enough room now
+ */
+		if (fitpair(pag, need))
+			return 1;
+/*
+ * try again... update curbit and hmask as getpage would have
+ * done. because of our update of the current page, we do not
+ * need to read in anything. BUT we have to write the current
+ * [deferred] page out, as the window of failure is too great.
+ */
+		db->curbit = 2 * db->curbit +
+			((hash & (db->hmask + 1)) ? 2 : 1);
+		db->hmask |= db->hmask + 1;
+
+		if (lseek(db->pagf, OFF_PAG(db->pagbno), SEEK_SET) < 0
+		    || write(db->pagf, db->pagbuf, PBLKSIZ) < 0)
+			return 0;
+
+	} while (--smax);
+/*
+ * if we are here, this is real bad news. After SPLTMAX splits,
+ * we still cannot fit the key. say goodnight.
+ */
+#ifdef BADMESS
+	(void) write(2, "sdbm: cannot insert after SPLTMAX attempts.\n", 44);
+#endif
+	return 0;
+
+}
+
+/*
+ * the following two routines will break if
+ * deletions aren't taken into account. (ndbm bug)
+ */
+datum
+sdbm_firstkey(register DBM *db)
+{
+	if (db == NULL)
+		return errno = EINVAL, nullitem;
+/*
+ * start at page 0
+ */
+	if (lseek(db->pagf, OFF_PAG(0), SEEK_SET) < 0
+	    || read(db->pagf, db->pagbuf, PBLKSIZ) < 0)
+		return ioerr(db), nullitem;
+	db->pagbno = 0;
+	db->blkptr = 0;
+	db->keyptr = 0;
+
+	return getnext(db);
+}
+
+datum
+sdbm_nextkey(register DBM *db)
+{
+	if (db == NULL)
+		return errno = EINVAL, nullitem;
+	return getnext(db);
+}
+
+/*
+ * all important binary trie traversal
+ */
+static int
+getpage(register DBM *db, register long int hash)
+{
+	register int hbit;
+	register long dbit;
+	register long pagb;
+
+	dbit = 0;
+	hbit = 0;
+	while (dbit < db->maxbno && getdbit(db, dbit))
+		dbit = 2 * dbit + ((hash & (1 << hbit++)) ? 2 : 1);
+
+	debug(("dbit: %d...", dbit));
+
+	db->curbit = dbit;
+	db->hmask = masks[hbit];
+
+	pagb = hash & db->hmask;
+/*
+ * see if the block we need is already in memory.
+ * note: this lookaside cache has about 10% hit rate.
+ */
+	if (pagb != db->pagbno) { 
+/*
+ * note: here, we assume a "hole" is read as 0s.
+ * if not, must zero pagbuf first.
+ */
+		if (lseek(db->pagf, OFF_PAG(pagb), SEEK_SET) < 0
+		    || read(db->pagf, db->pagbuf, PBLKSIZ) < 0)
+			return 0;
+		if (!chkpage(db->pagbuf))
+			return 0;
+		db->pagbno = pagb;
+
+		debug(("pag read: %d\n", pagb));
+	}
+	return 1;
+}
+
+static int
+getdbit(register DBM *db, register long int dbit)
+{
+	register long c;
+	register long dirb;
+
+	c = dbit / BYTESIZ;
+	dirb = c / DBLKSIZ;
+
+	if (dirb != db->dirbno) {
+		if (lseek(db->dirf, OFF_DIR(dirb), SEEK_SET) < 0
+		    || read(db->dirf, db->dirbuf, DBLKSIZ) < 0)
+			return 0;
+		db->dirbno = dirb;
+
+		debug(("dir read: %d\n", dirb));
+	}
+
+	return db->dirbuf[c % DBLKSIZ] & (1 << dbit % BYTESIZ);
+}
+
+static int
+setdbit(register DBM *db, register long int dbit)
+{
+	register long c;
+	register long dirb;
+
+	c = dbit / BYTESIZ;
+	dirb = c / DBLKSIZ;
+
+	if (dirb != db->dirbno) {
+		if (lseek(db->dirf, OFF_DIR(dirb), SEEK_SET) < 0
+		    || read(db->dirf, db->dirbuf, DBLKSIZ) < 0)
+			return 0;
+		db->dirbno = dirb;
+
+		debug(("dir read: %d\n", dirb));
+	}
+
+	db->dirbuf[c % DBLKSIZ] |= (1 << dbit % BYTESIZ);
+
+	if (dbit >= db->maxbno)
+		db->maxbno += DBLKSIZ * BYTESIZ;
+
+	if (lseek(db->dirf, OFF_DIR(dirb), SEEK_SET) < 0
+	    || write(db->dirf, db->dirbuf, DBLKSIZ) < 0)
+		return 0;
+
+	return 1;
+}
+
+/*
+ * getnext - get the next key in the page, and if done with
+ * the page, try the next page in sequence
+ */
+static datum
+getnext(register DBM *db)
+{
+	datum key;
+
+	for (;;) {
+		db->keyptr++;
+		key = getnkey(db->pagbuf, db->keyptr);
+		if (key.dptr != NULL)
+			return key;
+/*
+ * we either run out, or there is nothing on this page..
+ * try the next one... If we lost our position on the
+ * file, we will have to seek.
+ */
+		db->keyptr = 0;
+		if (db->pagbno != db->blkptr++)
+			if (lseek(db->pagf, OFF_PAG(db->blkptr), SEEK_SET) < 0)
+				break;
+		db->pagbno = db->blkptr;
+		if (read(db->pagf, db->pagbuf, PBLKSIZ) <= 0)
+			break;
+		if (!chkpage(db->pagbuf))
+			break;
+	}
+
+	return ioerr(db), nullitem;
+}
+
diff --git a/contrib/perl5/ext/SDBM_File/sdbm/sdbm.h b/contrib/perl5/ext/SDBM_File/sdbm/sdbm.h
new file mode 100644
index 0000000..84d5f75
--- /dev/null
+++ b/contrib/perl5/ext/SDBM_File/sdbm/sdbm.h
@@ -0,0 +1,290 @@
+/*
+ * sdbm - ndbm work-alike hashed database library
+ * based on Per-Ake Larson's Dynamic Hashing algorithms. BIT 18 (1978).
+ * author: oz@nexus.yorku.ca
+ * status: public domain. 
+ */
+#define DBLKSIZ 4096
+#define PBLKSIZ 1024
+#define PAIRMAX 1008			/* arbitrary on PBLKSIZ-N */
+#define SPLTMAX	10			/* maximum allowed splits */
+					/* for a single insertion */
+#ifdef VMS
+#define DIRFEXT	".sdbm_dir"
+#else
+#define DIRFEXT	".dir"
+#endif
+#define PAGFEXT	".pag"
+
+typedef struct {
+	int dirf;		       /* directory file descriptor */
+	int pagf;		       /* page file descriptor */
+	int flags;		       /* status/error flags, see below */
+	long maxbno;		       /* size of dirfile in bits */
+	long curbit;		       /* current bit number */
+	long hmask;		       /* current hash mask */
+	long blkptr;		       /* current block for nextkey */
+	int keyptr;		       /* current key for nextkey */
+	long blkno;		       /* current page to read/write */
+	long pagbno;		       /* current page in pagbuf */
+	char pagbuf[PBLKSIZ];	       /* page file block buffer */
+	long dirbno;		       /* current block in dirbuf */
+	char dirbuf[DBLKSIZ];	       /* directory file block buffer */
+} DBM;
+
+#define DBM_RDONLY	0x1	       /* data base open read-only */
+#define DBM_IOERR	0x2	       /* data base I/O error */
+
+/*
+ * utility macros
+ */
+#define sdbm_rdonly(db)		((db)->flags & DBM_RDONLY)
+#define sdbm_error(db)		((db)->flags & DBM_IOERR)
+
+#define sdbm_clearerr(db)	((db)->flags &= ~DBM_IOERR)  /* ouch */
+
+#define sdbm_dirfno(db)	((db)->dirf)
+#define sdbm_pagfno(db)	((db)->pagf)
+
+typedef struct {
+	char *dptr;
+	int dsize;
+} datum;
+
+EXTCONST datum nullitem
+#ifdef DOINIT
+                        = {0, 0}
+#endif
+                                   ;
+
+#if defined(__STDC__) || defined(__cplusplus) || defined(CAN_PROTOTYPE)
+#define proto(p) p
+#else
+#define proto(p) ()
+#endif
+
+/*
+ * flags to sdbm_store
+ */
+#define DBM_INSERT	0
+#define DBM_REPLACE	1
+
+/*
+ * ndbm interface
+ */
+extern DBM *sdbm_open proto((char *, int, int));
+extern void sdbm_close proto((DBM *));
+extern datum sdbm_fetch proto((DBM *, datum));
+extern int sdbm_delete proto((DBM *, datum));
+extern int sdbm_store proto((DBM *, datum, datum, int));
+extern datum sdbm_firstkey proto((DBM *));
+extern datum sdbm_nextkey proto((DBM *));
+
+/*
+ * other
+ */
+extern DBM *sdbm_prep proto((char *, char *, int, int));
+extern long sdbm_hash proto((char *, int));
+
+#ifndef SDBM_ONLY
+#define dbm_open sdbm_open
+#define dbm_close sdbm_close
+#define dbm_fetch sdbm_fetch
+#define dbm_store sdbm_store
+#define dbm_delete sdbm_delete
+#define dbm_firstkey sdbm_firstkey
+#define dbm_nextkey sdbm_nextkey
+#define dbm_error sdbm_error
+#define dbm_clearerr sdbm_clearerr
+#endif
+
+/* Most of the following is stolen from perl.h. */
+#ifndef H_PERL  /* Include guard */
+
+/*
+ * The following contortions are brought to you on behalf of all the
+ * standards, semi-standards, de facto standards, not-so-de-facto standards
+ * of the world, as well as all the other botches anyone ever thought of.
+ * The basic theory is that if we work hard enough here, the rest of the
+ * code can be a lot prettier.  Well, so much for theory.  Sorry, Henry...
+ */
+
+#include <errno.h>
+#ifdef HAS_SOCKET
+#   ifdef I_NET_ERRNO
+#     include <net/errno.h>
+#   endif
+#endif
+
+#if defined(__STDC__) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus)
+# define STANDARD_C 1
+#endif
+
+#include <stdio.h>
+#include <ctype.h>
+#include <setjmp.h>
+
+#if defined(I_UNISTD)
+#include <unistd.h>
+#endif
+
+#ifdef VMS
+#  include <file.h>
+#  include <unixio.h>
+#endif
+
+#ifdef I_SYS_PARAM
+#   if !defined(MSDOS) && !defined(WIN32) && !defined(VMS)
+#       ifdef PARAM_NEEDS_TYPES
+#	    include <sys/types.h>
+#       endif
+#       include <sys/param.h>
+#   endif
+#endif
+
+#ifndef _TYPES_		/* If types.h defines this it's easy. */
+#   ifndef major		/* Does everyone's types.h define this? */
+#	include <sys/types.h>
+#   endif
+#endif
+
+#include <sys/stat.h>
+
+#ifndef SEEK_SET
+# ifdef L_SET
+#  define SEEK_SET	L_SET
+# else
+#  define SEEK_SET	0  /* Wild guess. */
+# endif
+#endif
+
+/* Use all the "standard" definitions? */
+#if defined(STANDARD_C) && defined(I_STDLIB)
+#   include <stdlib.h>
+#endif /* STANDARD_C */
+
+#define MEM_SIZE Size_t
+
+/* This comes after <stdlib.h> so we don't try to change the standard
+ * library prototypes; we'll use our own instead. */
+
+#if defined(MYMALLOC) && (defined(HIDEMYMALLOC) || defined(EMBEDMYMALLOC))
+
+#   ifdef HIDEMYMALLOC
+#	define malloc  Mymalloc
+#	define calloc  Mycalloc
+#	define realloc Myremalloc
+#	define free    Myfree
+#   endif
+#   ifdef EMBEDMYMALLOC
+#	define malloc  Perl_malloc
+#	define calloc  Perl_calloc
+#	define realloc Perl_realloc
+#	define free    Perl_free
+#   endif
+
+    Malloc_t malloc proto((MEM_SIZE nbytes));
+    Malloc_t calloc proto((MEM_SIZE elements, MEM_SIZE size));
+    Malloc_t realloc proto((Malloc_t where, MEM_SIZE nbytes));
+    Free_t   free proto((Malloc_t where));
+
+#endif /* MYMALLOC && (HIDEMYMALLOC || EMBEDMYMALLOC) */
+
+#ifdef I_STRING
+#include <string.h>
+#else
+#include <strings.h>
+#endif
+
+#ifdef I_MEMORY
+#include <memory.h>
+#endif      
+
+#ifdef __cplusplus
+#define HAS_MEMCPY
+#endif
+
+#ifdef HAS_MEMCPY
+#  if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY)
+#    ifndef memcpy
+        extern char * memcpy proto((char*, char*, int));
+#    endif
+#  endif
+#else
+#   ifndef memcpy
+#	ifdef HAS_BCOPY
+#	    define memcpy(d,s,l) bcopy(s,d,l)
+#	else
+#	    define memcpy(d,s,l) my_bcopy(s,d,l)
+#	endif
+#   endif
+#endif /* HAS_MEMCPY */
+
+#ifdef HAS_MEMSET
+#  if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY)
+#    ifndef memset
+	extern char *memset proto((char*, int, int));
+#    endif
+#  endif
+#  define memzero(d,l) memset(d,0,l)
+#else
+#   ifndef memzero
+#	ifdef HAS_BZERO
+#	    define memzero(d,l) bzero(d,l)
+#	else
+#	    define memzero(d,l) my_bzero(d,l)
+#	endif
+#   endif
+#endif /* HAS_MEMSET */
+
+#if defined(mips) && defined(ultrix) && !defined(__STDC__)
+#   undef HAS_MEMCMP
+#endif
+
+#if defined(HAS_MEMCMP) && defined(HAS_SANE_MEMCMP)
+#  if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY)
+#    ifndef memcmp
+	extern int memcmp proto((char*, char*, int));
+#    endif
+#  endif
+#  ifdef BUGGY_MSC
+  #  pragma function(memcmp)
+#  endif
+#else
+#   ifndef memcmp
+	/* maybe we should have included the full embedding header... */
+#	ifdef NO_EMBED
+#	    define memcmp my_memcmp
+#	else
+#	    define memcmp Perl_my_memcmp
+#	endif
+#ifndef __cplusplus
+	extern int memcmp proto((char*, char*, int));
+#endif
+#   endif
+#endif /* HAS_MEMCMP */
+
+#ifndef HAS_BCMP
+#   ifndef bcmp
+#	define bcmp(s1,s2,l) memcmp(s1,s2,l)
+#   endif
+#endif /* !HAS_BCMP */
+
+#ifdef HAS_MEMCMP
+#  define memNE(s1,s2,l) (memcmp(s1,s2,l))
+#  define memEQ(s1,s2,l) (!memcmp(s1,s2,l))
+#else
+#  define memNE(s1,s2,l) (bcmp(s1,s2,l))
+#  define memEQ(s1,s2,l) (!bcmp(s1,s2,l))
+#endif
+
+#ifdef I_NETINET_IN
+#  ifdef VMS
+#    include <in.h>
+#  else
+#    include <netinet/in.h>
+#  endif
+#endif
+
+#endif /* Include guard */
+
diff --git a/contrib/perl5/ext/SDBM_File/sdbm/tune.h b/contrib/perl5/ext/SDBM_File/sdbm/tune.h
new file mode 100644
index 0000000..b95c8c8
--- /dev/null
+++ b/contrib/perl5/ext/SDBM_File/sdbm/tune.h
@@ -0,0 +1,23 @@
+/*
+ * sdbm - ndbm work-alike hashed database library
+ * tuning and portability constructs [not nearly enough]
+ * author: oz@nexus.yorku.ca
+ */
+
+#define BYTESIZ		8
+
+/*
+ * important tuning parms (hah)
+ */
+
+#define SEEDUPS			/* always detect duplicates */
+#define BADMESS			/* generate a message for worst case:
+				   cannot make room after SPLTMAX splits */
+/*
+ * misc
+ */
+#ifdef DEBUG
+#define debug(x)	printf x
+#else
+#define debug(x)
+#endif
diff --git a/contrib/perl5/ext/SDBM_File/sdbm/util.c b/contrib/perl5/ext/SDBM_File/sdbm/util.c
new file mode 100644
index 0000000..16bd4ac
--- /dev/null
+++ b/contrib/perl5/ext/SDBM_File/sdbm/util.c
@@ -0,0 +1,47 @@
+#include <stdio.h>
+#ifdef SDBM
+#include "sdbm.h"
+#else
+#include "ndbm.h"
+#endif
+
+void
+oops(register char *s1, register char *s2)
+{
+	extern int errno, sys_nerr;
+	extern char *sys_errlist[];
+	extern char *progname;
+
+	if (progname)
+		fprintf(stderr, "%s: ", progname);
+	fprintf(stderr, s1, s2);
+	if (errno > 0 && errno < sys_nerr)
+		fprintf(stderr, " (%s)", sys_errlist[errno]);
+	fprintf(stderr, "\n");
+	exit(1);
+}
+
+int
+okpage(char *pag)
+{
+	register unsigned n;
+	register off;
+	register short *ino = (short *) pag;
+
+	if ((n = ino[0]) > PBLKSIZ / sizeof(short))
+		return 0;
+
+	if (!n)
+		return 1;
+
+	off = PBLKSIZ;
+	for (ino++; n; ino += 2) {
+		if (ino[0] > off || ino[1] > off ||
+		    ino[1] > ino[0])
+			return 0;
+		off = ino[1];
+		n -= 2;
+	}
+
+	return 1;
+}
diff --git a/contrib/perl5/ext/SDBM_File/typemap b/contrib/perl5/ext/SDBM_File/typemap
new file mode 100644
index 0000000..317a8f3
--- /dev/null
+++ b/contrib/perl5/ext/SDBM_File/typemap
@@ -0,0 +1,27 @@
+#
+#################################### DBM SECTION
+#
+
+datum			T_DATUM
+gdatum			T_GDATUM
+NDBM_File		T_PTROBJ
+GDBM_File		T_PTROBJ
+SDBM_File		T_PTROBJ
+ODBM_File		T_PTROBJ
+DB_File			T_PTROBJ
+DBZ_File		T_PTROBJ
+FATALFUNC		T_OPAQUEPTR
+
+INPUT
+T_DATUM
+	$var.dptr = SvPV($arg, PL_na);
+	$var.dsize = (int)PL_na;
+T_GDATUM
+	UNIMPLEMENTED
+OUTPUT
+T_DATUM
+	sv_setpvn($arg, $var.dptr, $var.dsize);
+T_GDATUM
+	sv_usepvn($arg, $var.dptr, $var.dsize);
+T_PTROBJ
+        sv_setref_pv($arg, dbtype, (void*)$var);
diff --git a/contrib/perl5/ext/Socket/Makefile.PL b/contrib/perl5/ext/Socket/Makefile.PL
new file mode 100644
index 0000000..7b9469a
--- /dev/null
+++ b/contrib/perl5/ext/Socket/Makefile.PL
@@ -0,0 +1,7 @@
+use ExtUtils::MakeMaker;
+WriteMakefile(
+    NAME	=> 'Socket',
+    VERSION_FROM => 'Socket.pm',
+    MAN3PODS 	=> ' ', 	# Pods will be built by installman.
+    XSPROTOARG => '-noprototypes', 		# XXX remove later?
+);
diff --git a/contrib/perl5/ext/Socket/Socket.pm b/contrib/perl5/ext/Socket/Socket.pm
new file mode 100644
index 0000000..5a4870f
--- /dev/null
+++ b/contrib/perl5/ext/Socket/Socket.pm
@@ -0,0 +1,307 @@
+package Socket;
+
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+$VERSION = "1.7";
+
+=head1 NAME
+
+Socket, sockaddr_in, sockaddr_un, inet_aton, inet_ntoa - load the C socket.h defines and structure manipulators 
+
+=head1 SYNOPSIS
+
+    use Socket;
+
+    $proto = getprotobyname('udp');
+    socket(Socket_Handle, PF_INET, SOCK_DGRAM, $proto);
+    $iaddr = gethostbyname('hishost.com');
+    $port = getservbyname('time', 'udp');
+    $sin = sockaddr_in($port, $iaddr);
+    send(Socket_Handle, 0, 0, $sin);
+
+    $proto = getprotobyname('tcp');
+    socket(Socket_Handle, PF_INET, SOCK_STREAM, $proto);
+    $port = getservbyname('smtp', 'tcp');
+    $sin = sockaddr_in($port,inet_aton("127.1"));
+    $sin = sockaddr_in(7,inet_aton("localhost"));
+    $sin = sockaddr_in(7,INADDR_LOOPBACK);
+    connect(Socket_Handle,$sin);
+
+    ($port, $iaddr) = sockaddr_in(getpeername(Socket_Handle));
+    $peer_host = gethostbyaddr($iaddr, AF_INET);
+    $peer_addr = inet_ntoa($iaddr);
+
+    $proto = getprotobyname('tcp');
+    socket(Socket_Handle, PF_UNIX, SOCK_STREAM, $proto);
+    unlink('/tmp/usock');
+    $sun = sockaddr_un('/tmp/usock');
+    connect(Socket_Handle,$sun);
+
+=head1 DESCRIPTION
+
+This module is just a translation of the C F<socket.h> file.
+Unlike the old mechanism of requiring a translated F<socket.ph>
+file, this uses the B<h2xs> program (see the Perl source distribution)
+and your native C compiler.  This means that it has a 
+far more likely chance of getting the numbers right.  This includes
+all of the commonly used pound-defines like AF_INET, SOCK_STREAM, etc.
+
+Also, some common socket "newline" constants are provided: the
+constants C<CR>, C<LF>, and C<CRLF>, as well as C<$CR>, C<$LF>, and
+C<$CRLF>, which map to C<\015>, C<\012>, and C<\015\012>.  If you do
+not want to use the literal characters in your programs, then use
+the constants provided here.  They are not exported by default, but can
+be imported individually, and with the C<:crlf> export tag:
+
+    use Socket qw(:DEFAULT :crlf);
+
+In addition, some structure manipulation functions are available:
+
+=over
+
+=item inet_aton HOSTNAME
+
+Takes a string giving the name of a host, and translates that
+to the 4-byte string (structure). Takes arguments of both
+the 'rtfm.mit.edu' type and '18.181.0.24'. If the host name
+cannot be resolved, returns undef. For multi-homed hosts (hosts
+with more than one address), the first address found is returned.
+
+=item inet_ntoa IP_ADDRESS
+
+Takes a four byte ip address (as returned by inet_aton())
+and translates it into a string of the form 'd.d.d.d'
+where the 'd's are numbers less than 256 (the normal
+readable four dotted number notation for internet addresses).
+
+=item INADDR_ANY
+
+Note: does not return a number, but a packed string.
+
+Returns the 4-byte wildcard ip address which specifies any
+of the hosts ip addresses. (A particular machine can have
+more than one ip address, each address corresponding to
+a particular network interface. This wildcard address
+allows you to bind to all of them simultaneously.)
+Normally equivalent to inet_aton('0.0.0.0').
+
+=item INADDR_BROADCAST
+
+Note: does not return a number, but a packed string.
+
+Returns the 4-byte 'this-lan' ip broadcast address.
+This can be useful for some protocols to solicit information
+from all servers on the same LAN cable.
+Normally equivalent to inet_aton('255.255.255.255').
+
+=item INADDR_LOOPBACK
+
+Note - does not return a number.
+
+Returns the 4-byte loopback address. Normally equivalent
+to inet_aton('localhost').
+
+=item INADDR_NONE
+
+Note - does not return a number.
+
+Returns the 4-byte 'invalid' ip address. Normally equivalent
+to inet_aton('255.255.255.255').
+
+=item sockaddr_in PORT, ADDRESS
+
+=item sockaddr_in SOCKADDR_IN
+
+In an array context, unpacks its SOCKADDR_IN argument and returns an array
+consisting of (PORT, ADDRESS).  In a scalar context, packs its (PORT,
+ADDRESS) arguments as a SOCKADDR_IN and returns it.  If this is confusing,
+use pack_sockaddr_in() and unpack_sockaddr_in() explicitly.
+
+=item pack_sockaddr_in PORT, IP_ADDRESS
+
+Takes two arguments, a port number and a 4 byte IP_ADDRESS (as returned by
+inet_aton()). Returns the sockaddr_in structure with those arguments
+packed in with AF_INET filled in.  For internet domain sockets, this
+structure is normally what you need for the arguments in bind(),
+connect(), and send(), and is also returned by getpeername(),
+getsockname() and recv().
+
+=item unpack_sockaddr_in SOCKADDR_IN
+
+Takes a sockaddr_in structure (as returned by pack_sockaddr_in()) and
+returns an array of two elements: the port and the 4-byte ip-address.
+Will croak if the structure does not have AF_INET in the right place.
+
+=item sockaddr_un PATHNAME
+
+=item sockaddr_un SOCKADDR_UN
+
+In an array context, unpacks its SOCKADDR_UN argument and returns an array
+consisting of (PATHNAME).  In a scalar context, packs its PATHNAME
+arguments as a SOCKADDR_UN and returns it.  If this is confusing, use
+pack_sockaddr_un() and unpack_sockaddr_un() explicitly.
+These are only supported if your system has E<lt>F<sys/un.h>E<gt>.
+
+=item pack_sockaddr_un PATH
+
+Takes one argument, a pathname. Returns the sockaddr_un structure with
+that path packed in with AF_UNIX filled in. For unix domain sockets, this
+structure is normally what you need for the arguments in bind(),
+connect(), and send(), and is also returned by getpeername(),
+getsockname() and recv().
+
+=item unpack_sockaddr_un SOCKADDR_UN
+
+Takes a sockaddr_un structure (as returned by pack_sockaddr_un())
+and returns the pathname.  Will croak if the structure does not
+have AF_UNIX in the right place.
+
+=back
+
+=cut
+
+use Carp;
+
+require Exporter;
+require DynaLoader;
+@ISA = qw(Exporter DynaLoader);
+@EXPORT = qw(
+	inet_aton inet_ntoa pack_sockaddr_in unpack_sockaddr_in
+	pack_sockaddr_un unpack_sockaddr_un
+	sockaddr_in sockaddr_un
+	INADDR_ANY INADDR_BROADCAST INADDR_LOOPBACK INADDR_NONE
+	AF_802
+	AF_APPLETALK
+	AF_CCITT
+	AF_CHAOS
+	AF_DATAKIT
+	AF_DECnet
+	AF_DLI
+	AF_ECMA
+	AF_GOSIP
+	AF_HYLINK
+	AF_IMPLINK
+	AF_INET
+	AF_LAT
+	AF_MAX
+	AF_NBS
+	AF_NIT
+	AF_NS
+	AF_OSI
+	AF_OSINET
+	AF_PUP
+	AF_SNA
+	AF_UNIX
+	AF_UNSPEC
+	AF_X25
+	MSG_DONTROUTE
+	MSG_MAXIOVLEN
+	MSG_OOB
+	MSG_PEEK
+	PF_802
+	PF_APPLETALK
+	PF_CCITT
+	PF_CHAOS
+	PF_DATAKIT
+	PF_DECnet
+	PF_DLI
+	PF_ECMA
+	PF_GOSIP
+	PF_HYLINK
+	PF_IMPLINK
+	PF_INET
+	PF_LAT
+	PF_MAX
+	PF_NBS
+	PF_NIT
+	PF_NS
+	PF_OSI
+	PF_OSINET
+	PF_PUP
+	PF_SNA
+	PF_UNIX
+	PF_UNSPEC
+	PF_X25
+	SOCK_DGRAM
+	SOCK_RAW
+	SOCK_RDM
+	SOCK_SEQPACKET
+	SOCK_STREAM
+	SOL_SOCKET
+	SOMAXCONN
+	SO_ACCEPTCONN
+	SO_BROADCAST
+	SO_DEBUG
+	SO_DONTLINGER
+	SO_DONTROUTE
+	SO_ERROR
+	SO_KEEPALIVE
+	SO_LINGER
+	SO_OOBINLINE
+	SO_RCVBUF
+	SO_RCVLOWAT
+	SO_RCVTIMEO
+	SO_REUSEADDR
+	SO_SNDBUF
+	SO_SNDLOWAT
+	SO_SNDTIMEO
+	SO_TYPE
+	SO_USELOOPBACK
+);
+
+@EXPORT_OK = qw(CR LF CRLF $CR $LF $CRLF);
+
+%EXPORT_TAGS = (
+    crlf    => [qw(CR LF CRLF $CR $LF $CRLF)],
+    all     => [@EXPORT, @EXPORT_OK],
+);
+
+BEGIN {
+    sub CR   () {"\015"}
+    sub LF   () {"\012"}
+    sub CRLF () {"\015\012"}
+}
+
+*CR   = \CR();
+*LF   = \LF();
+*CRLF = \CRLF();
+
+sub sockaddr_in {
+    if (@_ == 6 && !wantarray) { # perl5.001m compat; use this && die
+	my($af, $port, @quad) = @_;
+	carp "6-ARG sockaddr_in call is deprecated" if $^W;
+	pack_sockaddr_in($port, inet_aton(join('.', @quad)));
+    } elsif (wantarray) {
+	croak "usage:   (port,iaddr) = sockaddr_in(sin_sv)" unless @_ == 1;
+        unpack_sockaddr_in(@_);
+    } else {
+	croak "usage:   sin_sv = sockaddr_in(port,iaddr))" unless @_ == 2;
+        pack_sockaddr_in(@_);
+    }
+}
+
+sub sockaddr_un {
+    if (wantarray) {
+	croak "usage:   (filename) = sockaddr_un(sun_sv)" unless @_ == 1;
+        unpack_sockaddr_un(@_);
+    } else {
+	croak "usage:   sun_sv = sockaddr_un(filename)" unless @_ == 1;
+        pack_sockaddr_un(@_);
+    }
+}
+
+
+sub AUTOLOAD {
+    my($constname);
+    ($constname = $AUTOLOAD) =~ s/.*:://;
+    my $val = constant($constname, @_ ? $_[0] : 0);
+    if ($! != 0) {
+	my ($pack,$file,$line) = caller;
+	croak "Your vendor has not defined Socket macro $constname, used";
+    }
+    eval "sub $AUTOLOAD { $val }";
+    goto &$AUTOLOAD;
+}
+
+bootstrap Socket $VERSION;
+
+1;
diff --git a/contrib/perl5/ext/Socket/Socket.xs b/contrib/perl5/ext/Socket/Socket.xs
new file mode 100644
index 0000000..de0217b
--- /dev/null
+++ b/contrib/perl5/ext/Socket/Socket.xs
@@ -0,0 +1,890 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#ifndef VMS
+# ifdef I_SYS_TYPES
+#  include <sys/types.h>
+# endif
+#include <sys/socket.h>
+#ifdef MPE
+# define PF_INET AF_INET
+# define PF_UNIX AF_UNIX
+# define SOCK_RAW 3
+#endif
+#ifdef I_SYS_UN
+#include <sys/un.h>
+#endif
+# ifdef I_NETINET_IN
+#  include <netinet/in.h>
+# endif
+#include <netdb.h>
+#ifdef I_ARPA_INET
+# include <arpa/inet.h>
+#endif
+#else
+#include "sockadapt.h"
+#endif
+
+#ifndef AF_NBS
+#undef PF_NBS
+#endif
+
+#ifndef AF_X25
+#undef PF_X25
+#endif
+
+#ifndef INADDR_NONE
+#define INADDR_NONE	0xffffffff
+#endif /* INADDR_NONE */
+#ifndef INADDR_BROADCAST
+#define INADDR_BROADCAST	0xffffffff
+#endif /* INADDR_BROADCAST */
+#ifndef INADDR_LOOPBACK
+#define INADDR_LOOPBACK         0x7F000001
+#endif /* INADDR_LOOPBACK */
+
+#ifndef HAS_INET_ATON
+
+/* 
+ * Check whether "cp" is a valid ascii representation
+ * of an Internet address and convert to a binary address.
+ * Returns 1 if the address is valid, 0 if not.
+ * This replaces inet_addr, the return value from which
+ * cannot distinguish between failure and a local broadcast address.
+ */
+static int
+my_inet_aton(register const char *cp, struct in_addr *addr)
+{
+	register U32 val;
+	register int base;
+	register char c;
+	int nparts;
+	const char *s;
+	unsigned int parts[4];
+	register unsigned int *pp = parts;
+
+	if (!cp)
+		return 0;
+	for (;;) {
+		/*
+		 * Collect number up to ``.''.
+		 * Values are specified as for C:
+		 * 0x=hex, 0=octal, other=decimal.
+		 */
+		val = 0; base = 10;
+		if (*cp == '0') {
+			if (*++cp == 'x' || *cp == 'X')
+				base = 16, cp++;
+			else
+				base = 8;
+		}
+		while ((c = *cp) != '\0') {
+			if (isDIGIT(c)) {
+				val = (val * base) + (c - '0');
+				cp++;
+				continue;
+			}
+			if (base == 16 && (s=strchr(PL_hexdigit,c))) {
+				val = (val << 4) + 
+					((s - PL_hexdigit) & 15);
+				cp++;
+				continue;
+			}
+			break;
+		}
+		if (*cp == '.') {
+			/*
+			 * Internet format:
+			 *	a.b.c.d
+			 *	a.b.c	(with c treated as 16-bits)
+			 *	a.b	(with b treated as 24 bits)
+			 */
+			if (pp >= parts + 3 || val > 0xff)
+				return 0;
+			*pp++ = val, cp++;
+		} else
+			break;
+	}
+	/*
+	 * Check for trailing characters.
+	 */
+	if (*cp && !isSPACE(*cp))
+		return 0;
+	/*
+	 * Concoct the address according to
+	 * the number of parts specified.
+	 */
+	nparts = pp - parts + 1;	/* force to an int for switch() */
+	switch (nparts) {
+
+	case 1:				/* a -- 32 bits */
+		break;
+
+	case 2:				/* a.b -- 8.24 bits */
+		if (val > 0xffffff)
+			return 0;
+		val |= parts[0] << 24;
+		break;
+
+	case 3:				/* a.b.c -- 8.8.16 bits */
+		if (val > 0xffff)
+			return 0;
+		val |= (parts[0] << 24) | (parts[1] << 16);
+		break;
+
+	case 4:				/* a.b.c.d -- 8.8.8.8 bits */
+		if (val > 0xff)
+			return 0;
+		val |= (parts[0] << 24) | (parts[1] << 16) | (parts[2] << 8);
+		break;
+	}
+	addr->s_addr = htonl(val);
+	return 1;
+}
+
+#undef inet_aton
+#define inet_aton my_inet_aton
+
+#endif /* ! HAS_INET_ATON */
+
+
+static int
+not_here(char *s)
+{
+    croak("Socket::%s not implemented on this architecture", s);
+    return -1;
+}
+
+static double
+constant(char *name, int arg)
+{
+    errno = 0;
+    switch (*name) {
+    case 'A':
+	if (strEQ(name, "AF_802"))
+#ifdef AF_802
+	    return AF_802;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "AF_APPLETALK"))
+#ifdef AF_APPLETALK
+	    return AF_APPLETALK;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "AF_CCITT"))
+#ifdef AF_CCITT
+	    return AF_CCITT;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "AF_CHAOS"))
+#ifdef AF_CHAOS
+	    return AF_CHAOS;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "AF_DATAKIT"))
+#ifdef AF_DATAKIT
+	    return AF_DATAKIT;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "AF_DECnet"))
+#ifdef AF_DECnet
+	    return AF_DECnet;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "AF_DLI"))
+#ifdef AF_DLI
+	    return AF_DLI;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "AF_ECMA"))
+#ifdef AF_ECMA
+	    return AF_ECMA;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "AF_GOSIP"))
+#ifdef AF_GOSIP
+	    return AF_GOSIP;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "AF_HYLINK"))
+#ifdef AF_HYLINK
+	    return AF_HYLINK;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "AF_IMPLINK"))
+#ifdef AF_IMPLINK
+	    return AF_IMPLINK;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "AF_INET"))
+#ifdef AF_INET
+	    return AF_INET;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "AF_LAT"))
+#ifdef AF_LAT
+	    return AF_LAT;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "AF_MAX"))
+#ifdef AF_MAX
+	    return AF_MAX;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "AF_NBS"))
+#ifdef AF_NBS
+	    return AF_NBS;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "AF_NIT"))
+#ifdef AF_NIT
+	    return AF_NIT;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "AF_NS"))
+#ifdef AF_NS
+	    return AF_NS;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "AF_OSI"))
+#ifdef AF_OSI
+	    return AF_OSI;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "AF_OSINET"))
+#ifdef AF_OSINET
+	    return AF_OSINET;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "AF_PUP"))
+#ifdef AF_PUP
+	    return AF_PUP;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "AF_SNA"))
+#ifdef AF_SNA
+	    return AF_SNA;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "AF_UNIX"))
+#ifdef AF_UNIX
+	    return AF_UNIX;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "AF_UNSPEC"))
+#ifdef AF_UNSPEC
+	    return AF_UNSPEC;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "AF_X25"))
+#ifdef AF_X25
+	    return AF_X25;
+#else
+	    goto not_there;
+#endif
+	break;
+    case 'B':
+	break;
+    case 'C':
+	break;
+    case 'D':
+	break;
+    case 'E':
+	break;
+    case 'F':
+	break;
+    case 'G':
+	break;
+    case 'H':
+	break;
+    case 'I':
+	break;
+    case 'J':
+	break;
+    case 'K':
+	break;
+    case 'L':
+	break;
+    case 'M':
+	if (strEQ(name, "MSG_CTRUNC"))
+#if defined(MSG_CTRUNC) || defined(HAS_GNULIBC) /* XXX it's an enum */
+	    return MSG_CTRUNC;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "MSG_DONTROUTE"))
+#if defined(MSG_DONTROUTE) || defined(HAS_GNULIBC) /* XXX it's an enum */
+	    return MSG_DONTROUTE;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "MSG_MAXIOVLEN"))
+#ifdef MSG_MAXIOVLEN
+	    return MSG_MAXIOVLEN;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "MSG_OOB"))
+#if defined(MSG_OOB) || defined(HAS_GNULIBC) /* XXX it's an enum */
+	    return MSG_OOB;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "MSG_PEEK"))
+#if defined(MSG_PEEK) || defined(HAS_GNULIBC) /* XXX it's an enum */
+	    return MSG_PEEK;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "MSG_PROXY"))
+#if defined(MSG_PROXY) || defined(HAS_GNULIBC) /* XXX it's an enum */
+	    return MSG_PROXY;
+#else
+	    goto not_there;
+#endif
+	break;
+    case 'N':
+	break;
+    case 'O':
+	break;
+    case 'P':
+	if (strEQ(name, "PF_802"))
+#ifdef PF_802
+	    return PF_802;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "PF_APPLETALK"))
+#ifdef PF_APPLETALK
+	    return PF_APPLETALK;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "PF_CCITT"))
+#ifdef PF_CCITT
+	    return PF_CCITT;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "PF_CHAOS"))
+#ifdef PF_CHAOS
+	    return PF_CHAOS;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "PF_DATAKIT"))
+#ifdef PF_DATAKIT
+	    return PF_DATAKIT;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "PF_DECnet"))
+#ifdef PF_DECnet
+	    return PF_DECnet;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "PF_DLI"))
+#ifdef PF_DLI
+	    return PF_DLI;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "PF_ECMA"))
+#ifdef PF_ECMA
+	    return PF_ECMA;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "PF_GOSIP"))
+#ifdef PF_GOSIP
+	    return PF_GOSIP;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "PF_HYLINK"))
+#ifdef PF_HYLINK
+	    return PF_HYLINK;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "PF_IMPLINK"))
+#ifdef PF_IMPLINK
+	    return PF_IMPLINK;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "PF_INET"))
+#ifdef PF_INET
+	    return PF_INET;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "PF_LAT"))
+#ifdef PF_LAT
+	    return PF_LAT;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "PF_MAX"))
+#ifdef PF_MAX
+	    return PF_MAX;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "PF_NBS"))
+#ifdef PF_NBS
+	    return PF_NBS;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "PF_NIT"))
+#ifdef PF_NIT
+	    return PF_NIT;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "PF_NS"))
+#ifdef PF_NS
+	    return PF_NS;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "PF_OSI"))
+#ifdef PF_OSI
+	    return PF_OSI;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "PF_OSINET"))
+#ifdef PF_OSINET
+	    return PF_OSINET;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "PF_PUP"))
+#ifdef PF_PUP
+	    return PF_PUP;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "PF_SNA"))
+#ifdef PF_SNA
+	    return PF_SNA;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "PF_UNIX"))
+#ifdef PF_UNIX
+	    return PF_UNIX;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "PF_UNSPEC"))
+#ifdef PF_UNSPEC
+	    return PF_UNSPEC;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "PF_X25"))
+#ifdef PF_X25
+	    return PF_X25;
+#else
+	    goto not_there;
+#endif
+	break;
+    case 'Q':
+	break;
+    case 'R':
+	break;
+    case 'S':
+	if (strEQ(name, "SOCK_DGRAM"))
+#ifdef SOCK_DGRAM
+	    return SOCK_DGRAM;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "SOCK_RAW"))
+#ifdef SOCK_RAW
+	    return SOCK_RAW;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "SOCK_RDM"))
+#ifdef SOCK_RDM
+	    return SOCK_RDM;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "SOCK_SEQPACKET"))
+#ifdef SOCK_SEQPACKET
+	    return SOCK_SEQPACKET;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "SOCK_STREAM"))
+#ifdef SOCK_STREAM
+	    return SOCK_STREAM;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "SOL_SOCKET"))
+#ifdef SOL_SOCKET
+	    return SOL_SOCKET;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "SOMAXCONN"))
+#ifdef SOMAXCONN
+	    return SOMAXCONN;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "SO_ACCEPTCONN"))
+#ifdef SO_ACCEPTCONN
+	    return SO_ACCEPTCONN;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "SO_BROADCAST"))
+#ifdef SO_BROADCAST
+	    return SO_BROADCAST;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "SO_DEBUG"))
+#ifdef SO_DEBUG
+	    return SO_DEBUG;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "SO_DONTLINGER"))
+#ifdef SO_DONTLINGER
+	    return SO_DONTLINGER;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "SO_DONTROUTE"))
+#ifdef SO_DONTROUTE
+	    return SO_DONTROUTE;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "SO_ERROR"))
+#ifdef SO_ERROR
+	    return SO_ERROR;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "SO_KEEPALIVE"))
+#ifdef SO_KEEPALIVE
+	    return SO_KEEPALIVE;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "SO_LINGER"))
+#ifdef SO_LINGER
+	    return SO_LINGER;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "SO_OOBINLINE"))
+#ifdef SO_OOBINLINE
+	    return SO_OOBINLINE;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "SO_RCVBUF"))
+#ifdef SO_RCVBUF
+	    return SO_RCVBUF;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "SO_RCVLOWAT"))
+#ifdef SO_RCVLOWAT
+	    return SO_RCVLOWAT;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "SO_RCVTIMEO"))
+#ifdef SO_RCVTIMEO
+	    return SO_RCVTIMEO;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "SO_REUSEADDR"))
+#ifdef SO_REUSEADDR
+	    return SO_REUSEADDR;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "SO_REUSEPORT"))
+#ifdef SO_REUSEPORT
+	    return SO_REUSEPORT;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "SO_SNDBUF"))
+#ifdef SO_SNDBUF
+	    return SO_SNDBUF;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "SO_SNDLOWAT"))
+#ifdef SO_SNDLOWAT
+	    return SO_SNDLOWAT;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "SO_SNDTIMEO"))
+#ifdef SO_SNDTIMEO
+	    return SO_SNDTIMEO;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "SO_TYPE"))
+#ifdef SO_TYPE
+	    return SO_TYPE;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "SO_USELOOPBACK"))
+#ifdef SO_USELOOPBACK
+	    return SO_USELOOPBACK;
+#else
+	    goto not_there;
+#endif
+	break;
+    case 'T':
+	break;
+    case 'U':
+	break;
+    case 'V':
+	break;
+    case 'W':
+	break;
+    case 'X':
+	break;
+    case 'Y':
+	break;
+    case 'Z':
+	break;
+    }
+    errno = EINVAL;
+    return 0;
+
+not_there:
+    errno = ENOENT;
+    return 0;
+}
+
+
+MODULE = Socket		PACKAGE = Socket
+
+double
+constant(name,arg)
+	char *		name
+	int		arg
+
+
+void
+inet_aton(host)
+	char *	host
+	CODE:
+	{
+	struct in_addr ip_address;
+	struct hostent * phe;
+	int ok = inet_aton(host, &ip_address);
+
+	if (!ok && (phe = gethostbyname(host))) {
+		Copy( phe->h_addr, &ip_address, phe->h_length, char );
+		ok = 1;
+	}
+
+	ST(0) = sv_newmortal();
+	if (ok) {
+		sv_setpvn( ST(0), (char *)&ip_address, sizeof ip_address );
+	}
+	}
+
+void
+inet_ntoa(ip_address_sv)
+	SV *	ip_address_sv
+	CODE:
+	{
+	STRLEN addrlen;
+	struct in_addr addr;
+	char * addr_str;
+	char * ip_address = SvPV(ip_address_sv,addrlen);
+	if (addrlen != sizeof(addr)) {
+	    croak("Bad arg length for %s, length is %d, should be %d",
+			"Socket::inet_ntoa",
+			addrlen, sizeof(addr));
+	}
+
+	Copy( ip_address, &addr, sizeof addr, char );
+	addr_str = inet_ntoa(addr);
+
+	ST(0) = sv_2mortal(newSVpv(addr_str, strlen(addr_str)));
+	}
+
+void
+pack_sockaddr_un(pathname)
+	char *	pathname
+	CODE:
+	{
+#ifdef I_SYS_UN
+	struct sockaddr_un sun_ad; /* fear using sun */
+	STRLEN len;
+	Zero( &sun_ad, sizeof sun_ad, char );
+	sun_ad.sun_family = AF_UNIX;
+	len = strlen(pathname);
+	if (len > sizeof(sun_ad.sun_path))
+	    len = sizeof(sun_ad.sun_path);
+	Copy( pathname, sun_ad.sun_path, len, char );
+	ST(0) = sv_2mortal(newSVpv((char *)&sun_ad, sizeof sun_ad));
+#else
+	ST(0) = (SV *) not_here("pack_sockaddr_un");
+#endif
+	
+	}
+
+void
+unpack_sockaddr_un(sun_sv)
+	SV *	sun_sv
+	CODE:
+	{
+#ifdef I_SYS_UN
+	struct sockaddr_un addr;
+	STRLEN sockaddrlen;
+	char * sun_ad = SvPV(sun_sv,sockaddrlen);
+	char * e;
+
+	if (sockaddrlen != sizeof(addr)) {
+	    croak("Bad arg length for %s, length is %d, should be %d",
+			"Socket::unpack_sockaddr_un",
+			sockaddrlen, sizeof(addr));
+	}
+
+	Copy( sun_ad, &addr, sizeof addr, char );
+
+	if ( addr.sun_family != AF_UNIX ) {
+	    croak("Bad address family for %s, got %d, should be %d",
+			"Socket::unpack_sockaddr_un",
+			addr.sun_family,
+			AF_UNIX);
+	}
+	e = addr.sun_path;
+	while (*e && e < addr.sun_path + sizeof addr.sun_path)
+	    ++e;
+	ST(0) = sv_2mortal(newSVpv(addr.sun_path, e - addr.sun_path));
+#else
+	ST(0) = (SV *) not_here("unpack_sockaddr_un");
+#endif
+	}
+
+void
+pack_sockaddr_in(port,ip_address)
+	unsigned short	port
+	char *	ip_address
+	CODE:
+	{
+	struct sockaddr_in sin;
+
+	Zero( &sin, sizeof sin, char );
+	sin.sin_family = AF_INET;
+	sin.sin_port = htons(port);
+	Copy( ip_address, &sin.sin_addr, sizeof sin.sin_addr, char );
+
+	ST(0) = sv_2mortal(newSVpv((char *)&sin, sizeof sin));
+	}
+
+void
+unpack_sockaddr_in(sin_sv)
+	SV *	sin_sv
+	PPCODE:
+	{
+	STRLEN sockaddrlen;
+	struct sockaddr_in addr;
+	unsigned short	port;
+	struct in_addr	ip_address;
+	char *	sin = SvPV(sin_sv,sockaddrlen);
+	if (sockaddrlen != sizeof(addr)) {
+	    croak("Bad arg length for %s, length is %d, should be %d",
+			"Socket::unpack_sockaddr_in",
+			sockaddrlen, sizeof(addr));
+	}
+	Copy( sin, &addr,sizeof addr, char );
+	if ( addr.sin_family != AF_INET ) {
+	    croak("Bad address family for %s, got %d, should be %d",
+			"Socket::unpack_sockaddr_in",
+			addr.sin_family,
+			AF_INET);
+	} 
+	port = ntohs(addr.sin_port);
+	ip_address = addr.sin_addr;
+
+	EXTEND(SP, 2);
+	PUSHs(sv_2mortal(newSViv((IV) port)));
+	PUSHs(sv_2mortal(newSVpv((char *)&ip_address,sizeof ip_address)));
+	}
+
+void
+INADDR_ANY()
+	CODE:
+	{
+	struct in_addr	ip_address;
+	ip_address.s_addr = htonl(INADDR_ANY);
+	ST(0) = sv_2mortal(newSVpv((char *)&ip_address,sizeof ip_address ));
+	}
+
+void
+INADDR_LOOPBACK()
+	CODE:
+	{
+	struct in_addr	ip_address;
+	ip_address.s_addr = htonl(INADDR_LOOPBACK);
+	ST(0) = sv_2mortal(newSVpv((char *)&ip_address,sizeof ip_address));
+	}
+
+void
+INADDR_NONE()
+	CODE:
+	{
+	struct in_addr	ip_address;
+	ip_address.s_addr = htonl(INADDR_NONE);
+	ST(0) = sv_2mortal(newSVpv((char *)&ip_address,sizeof ip_address));
+	}
+
+void
+INADDR_BROADCAST()
+	CODE:
+	{
+	struct in_addr	ip_address;
+	ip_address.s_addr = htonl(INADDR_BROADCAST);
+	ST(0) = sv_2mortal(newSVpv((char *)&ip_address,sizeof ip_address));
+	}
diff --git a/contrib/perl5/ext/Thread/Makefile.PL b/contrib/perl5/ext/Thread/Makefile.PL
new file mode 100644
index 0000000..e252d4e
--- /dev/null
+++ b/contrib/perl5/ext/Thread/Makefile.PL
@@ -0,0 +1,7 @@
+use ExtUtils::MakeMaker;
+WriteMakefile(
+	NAME => 'Thread',
+	VERSION_FROM => 'Thread.pm',
+    MAN3PODS => ' '
+	);
+
diff --git a/contrib/perl5/ext/Thread/Notes b/contrib/perl5/ext/Thread/Notes
new file mode 100644
index 0000000..1505877
--- /dev/null
+++ b/contrib/perl5/ext/Thread/Notes
@@ -0,0 +1,13 @@
+Should cvcache be per CV (keyed by thread) or per thread (keyed by CV)?
+
+Maybe ought to protect all SVs by a mutex for SvREFCNT_{dec,inc},
+upgrades and so on. Then use SvMUTEX instead of CvMUTEX for CVs.
+On the other hand, people shouldn't expect concurrent operations
+on non-lexicals to be safe anyway.
+
+Probably don't need to bother keeping track of CvOWNER on clones.
+
+Either @_ needs to be made lexical or other arrangments need to be
+made so that some globs (or just *_) are per-thread.
+
+tokenbuf and buf probably ought to be global protected by a global lock.
diff --git a/contrib/perl5/ext/Thread/README b/contrib/perl5/ext/Thread/README
new file mode 100644
index 0000000..a6b22fb
--- /dev/null
+++ b/contrib/perl5/ext/Thread/README
@@ -0,0 +1,20 @@
+See the README.threads in the main perl 5.004_xx development
+distribution (x >= 50) for details of how to build and use this.
+If all else fails, read on.
+
+If your version of patch can't create a file from scratch, then you'll
+need to create an empty thread.h manually first.  Perl itself will need
+to be built with -DUSE_THREADS yet. If you're using MIT pthreads or
+another threads package that needs pthread_init() to be called, then
+add -DNEED_PTHREAD_INIT. If you're using a threads library that only
+follows one of the old POSIX drafts, then you'll probably need to add
+-DOLD_PTHREADS_API. I haven't tested -DOLD_PTHREADS_API properly yet
+and I think you may still have to tweak a couple of the mutex calls
+to follow the old API.
+
+This extension is copyright Malcolm Beattie 1995-1997 and is freely
+distributable under your choice of the GNU Public License or the
+Artistic License (see the main perl distribution).
+
+Malcolm Beattie
+mbeattie@sable.ox.ac.uk
diff --git a/contrib/perl5/ext/Thread/Thread.pm b/contrib/perl5/ext/Thread/Thread.pm
new file mode 100644
index 0000000..c8bca0d
--- /dev/null
+++ b/contrib/perl5/ext/Thread/Thread.pm
@@ -0,0 +1,185 @@
+package Thread;
+require Exporter;
+require DynaLoader;
+use vars qw($VERSION @ISA @EXPORT);
+
+$VERSION = "1.0";
+
+@ISA = qw(Exporter DynaLoader);
+@EXPORT_OK = qw(yield cond_signal cond_broadcast cond_wait async);
+
+=head1 NAME
+
+Thread - multithreading
+
+=head1 SYNOPSIS
+
+    use Thread;
+
+    my $t = new Thread \&start_sub, @start_args;
+
+    $t->join;
+
+    my $tid = Thread->self->tid; 
+
+    my $tlist = Thread->list;
+
+    lock($scalar);
+
+    use Thread 'async';
+
+    use Thread 'eval';
+
+=head1 DESCRIPTION
+
+The C<Thread> module provides multithreading support for perl.
+
+=head1 FUNCTIONS
+
+=over 8
+
+=item new \&start_sub
+
+=item new \&start_sub, LIST
+
+C<new> starts a new thread of execution in the referenced subroutine. The
+optional list is passed as parameters to the subroutine. Execution
+continues in both the subroutine and the code after the C<new> call.
+
+C<new Thread> returns a thread object representing the newly created
+thread.
+
+=item lock VARIABLE
+
+C<lock> places a lock on a variable until the lock goes out of scope.  If
+the variable is locked by another thread, the C<lock> call will block until
+it's available. C<lock> is recursive, so multiple calls to C<lock> are
+safe--the variable will remain locked until the outermost lock on the
+variable goes out of scope.
+
+Locks on variables only affect C<lock> calls--they do I<not> affect normal
+access to a variable. (Locks on subs are different, and covered in a bit)
+If you really, I<really> want locks to block access, then go ahead and tie
+them to something and manage this yourself. This is done on purpose. While
+managing access to variables is a good thing, perl doesn't force you out of
+its living room...
+
+If a container object, such as a hash or array, is locked, all the elements
+of that container are not locked. For example, if a thread does a C<lock
+@a>, any other thread doing a C<lock($a[12])> won't block.
+
+You may also C<lock> a sub, using C<lock &sub>. Any calls to that sub from
+another thread will block until the lock is released. This behaviour is not
+equvalent to C<use attrs qw(locked)> in the sub. C<use attrs qw(locked)>
+serializes access to a subroutine, but allows different threads
+non-simultaneous access. C<lock &sub>, on the other hand, will not allow
+I<any> other thread access for the duration of the lock.
+
+Finally, C<lock> will traverse up references exactly I<one> level.
+C<lock(\$a)> is equivalent to C<lock($a)>, while C<lock(\\$a)> is not.
+
+=item async BLOCK;
+
+C<async> creates a thread to execute the block immediately following
+it. This block is treated as an anonymous sub, and so must have a
+semi-colon after the closing brace. Like C<new Thread>, C<async> returns a
+thread object.
+
+=item Thread->self
+
+The C<Thread-E<gt>self> function returns a thread object that represents
+the thread making the C<Thread-E<gt>self> call.
+
+=item Thread->list
+
+C<Thread-E<gt>list> returns a list of thread objects for all running and
+finished but un-C<join>ed threads.
+
+=item cond_wait VARIABLE
+
+The C<cond_wait> function takes a B<locked> variable as a parameter,
+unlocks the variable, and blocks until another thread does a C<cond_signal>
+or C<cond_broadcast> for that same locked variable. The variable that
+C<cond_wait> blocked on is relocked after the C<cond_wait> is satisfied.
+If there are multiple threads C<cond_wait>ing on the same variable, all but
+one will reblock waiting to reaquire the lock on the variable. (So if
+you're only using C<cond_wait> for synchronization, give up the lock as
+soon as possible)
+
+=item cond_signal VARIABLE
+
+The C<cond_signal> function takes a locked variable as a parameter and
+unblocks one thread that's C<cond_wait>ing on that variable. If more than
+one thread is blocked in a C<cond_wait> on that variable, only one (and
+which one is indeterminate) will be unblocked.
+
+If there are no threads blocked in a C<cond_wait> on the variable, the
+signal is discarded.
+
+=item cond_broadcast VARIABLE
+
+The C<cond_broadcast> function works similarly to C<cond_wait>.
+C<cond_broadcast>, though, will unblock B<all> the threads that are blocked
+in a C<cond_wait> on the locked variable, rather than only one.
+
+=back
+
+=head1 METHODS
+
+=over 8
+
+=item join
+
+C<join> waits for a thread to end and returns any values the thread exited
+with. C<join> will block until the thread has ended, though it won't block
+if the thread has already terminated.
+
+If the thread being C<join>ed C<die>d, the error it died with will be
+returned at this time. If you don't want the thread performing the C<join>
+to die as well, you should either wrap the C<join> in an C<eval> or use the
+C<eval> thread method instead of C<join>.
+
+=item eval
+
+The C<eval> method wraps an C<eval> around a C<join>, and so waits for a
+thread to exit, passing along any values the thread might have returned.
+Errors, of course, get placed into C<$@>.
+
+=item tid
+
+The C<tid> method returns the tid of a thread. The tid is a monotonically
+increasing integer assigned when a thread is created. The main thread of a
+program will have a tid of zero, while subsequent threads will have tids
+assigned starting with one.
+
+=head1 LIMITATIONS
+
+The sequence number used to assign tids is a simple integer, and no
+checking is done to make sure the tid isn't currently in use. If a program
+creates more than 2^32 - 1 threads in a single run, threads may be assigned
+duplicate tids. This limitation may be lifted in a future version of Perl.
+
+=head1 SEE ALSO
+
+L<attrs>, L<Thread::Queue>, L<Thread::Semaphore>, L<Thread::Specific>.
+
+=cut
+
+#
+# Methods
+#
+
+#
+# Exported functions
+#
+sub async (&) {
+    return new Thread $_[0];
+}
+
+sub eval {
+    return eval { shift->join; };
+}
+
+bootstrap Thread;
+
+1;
diff --git a/contrib/perl5/ext/Thread/Thread.xs b/contrib/perl5/ext/Thread/Thread.xs
new file mode 100644
index 0000000..48f8aa0
--- /dev/null
+++ b/contrib/perl5/ext/Thread/Thread.xs
@@ -0,0 +1,641 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+/* Magic signature for Thread's mg_private is "Th" */ 
+#define Thread_MAGIC_SIGNATURE 0x5468
+
+#ifdef __cplusplus
+#ifdef I_UNISTD
+#include <unistd.h>
+#endif
+#endif
+#include <fcntl.h>
+                        
+static int sig_pipe[2];
+            
+#ifndef THREAD_RET_TYPE
+#define THREAD_RET_TYPE void *
+#define THREAD_RET_CAST(x) ((THREAD_RET_TYPE) x)
+#endif
+
+static void
+remove_thread(struct perl_thread *t)
+{
+#ifdef USE_THREADS
+    DEBUG_S(WITH_THR(PerlIO_printf(PerlIO_stderr(),
+				   "%p: remove_thread %p\n", thr, t)));
+    MUTEX_LOCK(&PL_threads_mutex);
+    MUTEX_DESTROY(&t->mutex);
+    PL_nthreads--;
+    t->prev->next = t->next;
+    t->next->prev = t->prev;
+    COND_BROADCAST(&PL_nthreads_cond);
+    MUTEX_UNLOCK(&PL_threads_mutex);
+#endif
+}
+
+static THREAD_RET_TYPE
+threadstart(void *arg)
+{
+#ifdef USE_THREADS
+#ifdef FAKE_THREADS
+    Thread savethread = thr;
+    LOGOP myop;
+    dSP;
+    I32 oldscope = PL_scopestack_ix;
+    I32 retval;
+    AV *av;
+    int i;
+
+    DEBUG_S(PerlIO_printf(PerlIO_stderr(), "new thread %p starting at %s\n",
+			  thr, SvPEEK(TOPs)));
+    thr = (Thread) arg;
+    savemark = TOPMARK;
+    thr->prev = thr->prev_run = savethread;
+    thr->next = savethread->next;
+    thr->next_run = savethread->next_run;
+    savethread->next = savethread->next_run = thr;
+    thr->wait_queue = 0;
+    thr->private = 0;
+
+    /* Now duplicate most of perl_call_sv but with a few twists */
+    PL_op = (OP*)&myop;
+    Zero(PL_op, 1, LOGOP);
+    myop.op_flags = OPf_STACKED;
+    myop.op_next = Nullop;
+    myop.op_flags |= OPf_KNOW;
+    myop.op_flags |= OPf_WANT_LIST;
+    PL_op = pp_entersub(ARGS);
+    DEBUG_S(if (!PL_op)
+	    PerlIO_printf(PerlIO_stderr(), "thread starts at Nullop\n"));
+    /*
+     * When this thread is next scheduled, we start in the right
+     * place. When the thread runs off the end of the sub, perl.c
+     * handles things, using savemark to figure out how much of the
+     * stack is the return value for any join.
+     */
+    thr = savethread;		/* back to the old thread */
+    return 0;
+#else
+    Thread thr = (Thread) arg;
+    LOGOP myop;
+    djSP;
+    I32 oldmark = TOPMARK;
+    I32 oldscope = PL_scopestack_ix;
+    I32 retval;
+    SV *sv;
+    AV *av = newAV();
+    int i, ret;
+    dJMPENV;
+    DEBUG_S(PerlIO_printf(PerlIO_stderr(), "new thread %p waiting to start\n",
+			  thr));
+
+    /* Don't call *anything* requiring dTHR until after SET_THR() */
+    /*
+     * Wait until our creator releases us. If we didn't do this, then
+     * it would be potentially possible for out thread to carry on and
+     * do stuff before our creator fills in our "self" field. For example,
+     * if we went and created another thread which tried to JOIN with us,
+     * then we'd be in a mess.
+     */
+    MUTEX_LOCK(&thr->mutex);
+    MUTEX_UNLOCK(&thr->mutex);
+
+    /*
+     * It's safe to wait until now to set the thread-specific pointer
+     * from our pthread_t structure to our struct perl_thread, since
+     * we're the only thread who can get at it anyway.
+     */
+    SET_THR(thr);
+
+    /* Only now can we use SvPEEK (which calls sv_newmortal which does dTHR) */
+    DEBUG_S(PerlIO_printf(PerlIO_stderr(), "new thread %p starting at %s\n",
+			  thr, SvPEEK(TOPs)));
+
+    sv = POPs;
+    PUTBACK;
+    perl_call_sv(sv, G_ARRAY|G_EVAL);
+    SPAGAIN;
+    retval = SP - (PL_stack_base + oldmark);
+    SP = PL_stack_base + oldmark + 1;
+    if (SvCUR(thr->errsv)) {
+	MUTEX_LOCK(&thr->mutex);
+	thr->flags |= THRf_DID_DIE;
+	MUTEX_UNLOCK(&thr->mutex);
+	av_store(av, 0, &PL_sv_no);
+	av_store(av, 1, newSVsv(thr->errsv));
+	DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p died: %s\n",
+			      thr, SvPV(thr->errsv, PL_na)));
+    } else {
+	DEBUG_S(STMT_START {
+	    for (i = 1; i <= retval; i++) {
+		PerlIO_printf(PerlIO_stderr(), "%p return[%d] = %s\n",
+				thr, i, SvPEEK(SP[i - 1]));
+	    }
+	} STMT_END);
+	av_store(av, 0, &PL_sv_yes);
+	for (i = 1; i <= retval; i++, SP++)
+	    sv_setsv(*av_fetch(av, i, TRUE), SvREFCNT_inc(*SP));
+    }
+
+  finishoff:
+#if 0    
+    /* removed for debug */
+    SvREFCNT_dec(PL_curstack);
+#endif
+    SvREFCNT_dec(thr->cvcache);
+    SvREFCNT_dec(thr->threadsv);
+    SvREFCNT_dec(thr->specific);
+    SvREFCNT_dec(thr->errsv);
+    SvREFCNT_dec(thr->errhv);
+
+    /*Safefree(cxstack);*/
+    while (PL_curstackinfo->si_next)
+	PL_curstackinfo = PL_curstackinfo->si_next;
+    while (PL_curstackinfo) {
+	PERL_SI *p = PL_curstackinfo->si_prev;
+	SvREFCNT_dec(PL_curstackinfo->si_stack);
+	Safefree(PL_curstackinfo->si_cxstack);
+	Safefree(PL_curstackinfo);
+	PL_curstackinfo = p;
+    }    
+    Safefree(PL_markstack);
+    Safefree(PL_scopestack);
+    Safefree(PL_savestack);
+    Safefree(PL_retstack);
+    Safefree(PL_tmps_stack);
+    Safefree(PL_ofs);
+
+    SvREFCNT_dec(PL_rs);
+    SvREFCNT_dec(PL_nrs);
+    SvREFCNT_dec(PL_statname);
+    Safefree(PL_screamfirst);
+    Safefree(PL_screamnext);
+    Safefree(PL_reg_start_tmp);
+    SvREFCNT_dec(PL_lastscream);
+    /*SvREFCNT_dec(PL_defoutgv);*/
+
+    MUTEX_LOCK(&thr->mutex);
+    DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+			  "%p: threadstart finishing: state is %u\n",
+			  thr, ThrSTATE(thr)));
+    switch (ThrSTATE(thr)) {
+    case THRf_R_JOINABLE:
+	ThrSETSTATE(thr, THRf_ZOMBIE);
+	MUTEX_UNLOCK(&thr->mutex);
+	DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+			      "%p: R_JOINABLE thread finished\n", thr));
+	break;
+    case THRf_R_JOINED:
+	ThrSETSTATE(thr, THRf_DEAD);
+	MUTEX_UNLOCK(&thr->mutex);
+	remove_thread(thr);
+	DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+			      "%p: R_JOINED thread finished\n", thr));
+	break;
+    case THRf_R_DETACHED:
+	ThrSETSTATE(thr, THRf_DEAD);
+	MUTEX_UNLOCK(&thr->mutex);
+	SvREFCNT_dec(av);
+	DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+			      "%p: DETACHED thread finished\n", thr));
+	remove_thread(thr);	/* This might trigger main thread to finish */
+	break;
+    default:
+	MUTEX_UNLOCK(&thr->mutex);
+	croak("panic: illegal state %u at end of threadstart", ThrSTATE(thr));
+	/* NOTREACHED */
+    }
+    return THREAD_RET_CAST(av);	/* Available for anyone to join with */
+					/* us unless we're detached, in which */
+					/* case noone sees the value anyway. */
+#endif    
+#else
+    return THREAD_RET_CAST(NULL);
+#endif
+}
+
+static SV *
+newthread (SV *startsv, AV *initargs, char *classname)
+{
+#ifdef USE_THREADS
+    dSP;
+    Thread savethread;
+    int i;
+    SV *sv;
+    int err;
+#ifndef THREAD_CREATE
+    static pthread_attr_t attr;
+    static int attr_inited = 0;
+    sigset_t fullmask, oldmask;
+#endif
+    
+    savethread = thr;
+    thr = new_struct_thread(thr);
+    SPAGAIN;
+    DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+			  "%p: newthread (%p), tid is %u, preparing stack\n",
+			  savethread, thr, thr->tid));
+    /* The following pushes the arg list and startsv onto the *new* stack */
+    PUSHMARK(SP);
+    /* Could easily speed up the following greatly */
+    for (i = 0; i <= AvFILL(initargs); i++)
+	XPUSHs(SvREFCNT_inc(*av_fetch(initargs, i, FALSE)));
+    XPUSHs(SvREFCNT_inc(startsv));
+    PUTBACK;
+#ifdef THREAD_CREATE
+    err = THREAD_CREATE(thr, threadstart);
+#else    
+    /* On your marks... */
+    MUTEX_LOCK(&thr->mutex);
+    /* Get set...  */
+    sigfillset(&fullmask);
+    if (sigprocmask(SIG_SETMASK, &fullmask, &oldmask) == -1)
+	croak("panic: sigprocmask");
+    err = 0;
+    if (!attr_inited) {
+	attr_inited = 1;
+#ifdef OLD_PTHREADS_API
+	err = pthread_attr_create(&attr);
+#else
+	err = pthread_attr_init(&attr);
+#endif
+#ifdef OLD_PTHREADS_API
+#ifdef VMS
+/* This is available with the old pthreads API, but only with */
+/* DecThreads (VMS and Digital Unix) */
+	if (err == 0)
+	    err = pthread_attr_setdetach_np(&attr, ATTR_JOINABLE);
+#endif
+#else
+	if (err == 0)
+	    err = pthread_attr_setdetachstate(&attr, ATTR_JOINABLE);
+#endif
+    }
+    if (err == 0)
+#ifdef OLD_PTHREADS_API
+	err = pthread_create(&thr->self, attr, threadstart, (void*) thr);
+#else
+	err = pthread_create(&thr->self, &attr, threadstart, (void*) thr);
+#endif
+    /* Go */
+    MUTEX_UNLOCK(&thr->mutex);
+#endif
+    if (err) {
+        DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+			      "%p: create of %p failed %d\n",
+			      savethread, thr, err));
+	/* Thread creation failed--clean up */
+	SvREFCNT_dec(thr->cvcache);
+	remove_thread(thr);
+	MUTEX_DESTROY(&thr->mutex);
+	for (i = 0; i <= AvFILL(initargs); i++)
+	    SvREFCNT_dec(*av_fetch(initargs, i, FALSE));
+	SvREFCNT_dec(startsv);
+	return NULL;
+    }
+#ifdef THREAD_POST_CREATE
+    THREAD_POST_CREATE(thr);
+#else
+    if (sigprocmask(SIG_SETMASK, &oldmask, 0))
+	croak("panic: sigprocmask");
+#endif
+    sv = newSViv(thr->tid);
+    sv_magic(sv, thr->oursv, '~', 0, 0);
+    SvMAGIC(sv)->mg_private = Thread_MAGIC_SIGNATURE;
+    return sv_bless(newRV_noinc(sv), gv_stashpv(classname, TRUE));
+#else
+    croak("No threads in this perl");
+    return &PL_sv_undef;
+#endif
+}
+
+static Signal_t handle_thread_signal _((int sig));
+
+static Signal_t
+handle_thread_signal(int sig)
+{
+    unsigned char c = (unsigned char) sig;
+    /*
+     * We're not really allowed to call fprintf in a signal handler
+     * so don't be surprised if this isn't robust while debugging
+     * with -DL.
+     */
+    DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+	    "handle_thread_signal: got signal %d\n", sig););
+    write(sig_pipe[1], &c, 1);
+}
+
+MODULE = Thread		PACKAGE = Thread
+PROTOTYPES: DISABLE
+
+void
+new(classname, startsv, ...)
+	char *		classname
+	SV *		startsv
+	AV *		av = av_make(items - 2, &ST(2));
+    PPCODE:
+	XPUSHs(sv_2mortal(newthread(startsv, av, classname)));
+
+void
+join(t)
+	Thread	t
+	AV *	av = NO_INIT
+	int	i = NO_INIT
+    PPCODE:
+#ifdef USE_THREADS
+	DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: joining %p (state %u)\n",
+			      thr, t, ThrSTATE(t)););
+    	MUTEX_LOCK(&t->mutex);
+	switch (ThrSTATE(t)) {
+	case THRf_R_JOINABLE:
+	case THRf_R_JOINED:
+	    ThrSETSTATE(t, THRf_R_JOINED);
+	    MUTEX_UNLOCK(&t->mutex);
+	    break;
+	case THRf_ZOMBIE:
+	    ThrSETSTATE(t, THRf_DEAD);
+	    MUTEX_UNLOCK(&t->mutex);
+	    remove_thread(t);
+	    break;
+	default:
+	    MUTEX_UNLOCK(&t->mutex);
+	    croak("can't join with thread");
+	    /* NOTREACHED */
+	}
+	JOIN(t, &av);
+
+	if (SvTRUE(*av_fetch(av, 0, FALSE))) {
+	    /* Could easily speed up the following if necessary */
+	    for (i = 1; i <= AvFILL(av); i++)
+		XPUSHs(sv_2mortal(*av_fetch(av, i, FALSE)));
+	} else {
+	    char *mess = SvPV(*av_fetch(av, 1, FALSE), PL_na);
+	    DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+				  "%p: join propagating die message: %s\n",
+				  thr, mess));
+	    croak(mess);
+	}
+#endif
+
+void
+detach(t)
+	Thread	t
+    CODE:
+#ifdef USE_THREADS
+	DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: detaching %p (state %u)\n",
+			      thr, t, ThrSTATE(t)););
+    	MUTEX_LOCK(&t->mutex);
+	switch (ThrSTATE(t)) {
+	case THRf_R_JOINABLE:
+	    ThrSETSTATE(t, THRf_R_DETACHED);
+	    /* fall through */
+	case THRf_R_DETACHED:
+	    DETACH(t);
+	    MUTEX_UNLOCK(&t->mutex);
+	    break;
+	case THRf_ZOMBIE:
+	    ThrSETSTATE(t, THRf_DEAD);
+	    DETACH(t);
+	    MUTEX_UNLOCK(&t->mutex);
+	    remove_thread(t);
+	    break;
+	default:
+	    MUTEX_UNLOCK(&t->mutex);
+	    croak("can't detach thread");
+	    /* NOTREACHED */
+	}
+#endif
+
+void
+equal(t1, t2)
+	Thread	t1
+	Thread	t2
+    PPCODE:
+	PUSHs((t1 == t2) ? &PL_sv_yes : &PL_sv_no);
+
+void
+flags(t)
+	Thread	t
+    PPCODE:
+#ifdef USE_THREADS
+	PUSHs(sv_2mortal(newSViv(t->flags)));
+#endif
+
+void
+self(classname)
+	char *	classname
+    PREINIT:
+	SV *sv;
+    PPCODE:        
+#ifdef USE_THREADS
+	sv = newSViv(thr->tid);
+	sv_magic(sv, thr->oursv, '~', 0, 0);
+	SvMAGIC(sv)->mg_private = Thread_MAGIC_SIGNATURE;
+	PUSHs(sv_2mortal(sv_bless(newRV_noinc(sv),
+				  gv_stashpv(classname, TRUE))));
+#endif
+
+U32
+tid(t)
+	Thread	t
+    CODE:
+#ifdef USE_THREADS
+    	MUTEX_LOCK(&t->mutex);
+	RETVAL = t->tid;
+    	MUTEX_UNLOCK(&t->mutex);
+#else 
+	RETVAL = 0;
+#endif
+    OUTPUT:
+	RETVAL
+
+void
+DESTROY(t)
+	SV *	t
+    PPCODE:
+	PUSHs(&PL_sv_yes);
+
+void
+yield()
+    CODE:
+{
+#ifdef USE_THREADS
+	YIELD;
+#endif
+}
+
+void
+cond_wait(sv)
+	SV *	sv
+	MAGIC *	mg = NO_INIT
+CODE:                       
+#ifdef USE_THREADS
+	if (SvROK(sv))
+	    sv = SvRV(sv);
+
+	mg = condpair_magic(sv);
+	DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: cond_wait %p\n", thr, sv));
+	MUTEX_LOCK(MgMUTEXP(mg));
+	if (MgOWNER(mg) != thr) {
+	    MUTEX_UNLOCK(MgMUTEXP(mg));
+	    croak("cond_wait for lock that we don't own\n");
+	}
+	MgOWNER(mg) = 0;
+	COND_WAIT(MgCONDP(mg), MgMUTEXP(mg));
+	while (MgOWNER(mg))
+	    COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg));
+	MgOWNER(mg) = thr;
+	MUTEX_UNLOCK(MgMUTEXP(mg));
+#endif
+
+void
+cond_signal(sv)
+	SV *	sv
+	MAGIC *	mg = NO_INIT
+CODE:
+#ifdef USE_THREADS
+	if (SvROK(sv))
+	    sv = SvRV(sv);
+
+	mg = condpair_magic(sv);
+	DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: cond_signal %p\n",thr,sv));
+	MUTEX_LOCK(MgMUTEXP(mg));
+	if (MgOWNER(mg) != thr) {
+	    MUTEX_UNLOCK(MgMUTEXP(mg));
+	    croak("cond_signal for lock that we don't own\n");
+	}
+	COND_SIGNAL(MgCONDP(mg));
+	MUTEX_UNLOCK(MgMUTEXP(mg));
+#endif
+
+void
+cond_broadcast(sv)
+	SV *	sv
+	MAGIC *	mg = NO_INIT
+CODE: 
+#ifdef USE_THREADS
+	if (SvROK(sv))
+	    sv = SvRV(sv);
+
+	mg = condpair_magic(sv);
+	DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: cond_broadcast %p\n",
+			      thr, sv));
+	MUTEX_LOCK(MgMUTEXP(mg));
+	if (MgOWNER(mg) != thr) {
+	    MUTEX_UNLOCK(MgMUTEXP(mg));
+	    croak("cond_broadcast for lock that we don't own\n");
+	}
+	COND_BROADCAST(MgCONDP(mg));
+	MUTEX_UNLOCK(MgMUTEXP(mg));
+#endif
+
+void
+list(classname)
+	char *	classname
+    PREINIT:
+	Thread	t;
+	AV *	av;
+	SV **	svp;
+	int	n = 0;
+    PPCODE:
+#ifdef USE_THREADS
+	av = newAV();
+	/*
+	 * Iterate until we have enough dynamic storage for all threads.
+	 * We mustn't do any allocation while holding threads_mutex though.
+	 */
+	MUTEX_LOCK(&PL_threads_mutex);
+	do {
+	    n = PL_nthreads;
+	    MUTEX_UNLOCK(&PL_threads_mutex);
+	    if (AvFILL(av) < n - 1) {
+		int i = AvFILL(av);
+		for (i = AvFILL(av); i < n - 1; i++) {
+		    SV *sv = newSViv(0);	/* fill in tid later */
+		    sv_magic(sv, 0, '~', 0, 0);	/* fill in other magic later */
+		    av_push(av, sv_bless(newRV_noinc(sv),
+					 gv_stashpv(classname, TRUE)));
+	
+		}
+	    }
+	    MUTEX_LOCK(&PL_threads_mutex);
+	} while (n < PL_nthreads);
+	n = PL_nthreads;	/* Get the final correct value */
+
+	/*
+	 * At this point, there's enough room to fill in av.
+	 * Note that we are holding threads_mutex so the list
+	 * won't change out from under us but all the remaining
+	 * processing is "fast" (no blocking, malloc etc.)
+	 */
+	t = thr;
+	svp = AvARRAY(av);
+	do {
+	    SV *sv = (SV*)SvRV(*svp);
+	    sv_setiv(sv, t->tid);
+	    SvMAGIC(sv)->mg_obj = SvREFCNT_inc(t->oursv);
+	    SvMAGIC(sv)->mg_flags |= MGf_REFCOUNTED;
+	    SvMAGIC(sv)->mg_private = Thread_MAGIC_SIGNATURE;
+	    t = t->next;
+	    svp++;
+	} while (t != thr);
+	/*  */
+	MUTEX_UNLOCK(&PL_threads_mutex);
+	/* Truncate any unneeded slots in av */
+	av_fill(av, n - 1);
+	/* Finally, push all the new objects onto the stack and drop av */
+	EXTEND(SP, n);
+	for (svp = AvARRAY(av); n > 0; n--, svp++)
+	    PUSHs(*svp);
+	(void)sv_2mortal((SV*)av);
+#endif
+
+
+MODULE = Thread		PACKAGE = Thread::Signal
+
+void
+kill_sighandler_thread()
+    PPCODE:
+	write(sig_pipe[1], "\0", 1);
+	PUSHs(&PL_sv_yes);
+
+void
+init_thread_signals()
+    PPCODE:
+	PL_sighandlerp = handle_thread_signal;
+	if (pipe(sig_pipe) == -1)
+	    XSRETURN_UNDEF;
+	PUSHs(&PL_sv_yes);
+
+void
+await_signal()
+    PREINIT:
+	unsigned char c;
+	SSize_t ret;
+    CODE:
+	do {
+	    ret = read(sig_pipe[0], &c, 1);
+	} while (ret == -1 && errno == EINTR);
+	if (ret == -1)
+	    croak("panic: await_signal");
+	ST(0) = sv_newmortal();
+	if (ret)
+	    sv_setsv(ST(0), c ? psig_ptr[c] : &PL_sv_no);
+	DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+			      "await_signal returning %s\n", SvPEEK(ST(0))););
+
+MODULE = Thread		PACKAGE = Thread::Specific
+
+void
+data(classname = "Thread::Specific")
+	char *	classname
+    PPCODE:
+#ifdef USE_THREADS
+	if (AvFILL(thr->specific) == -1) {
+	    GV *gv = gv_fetchpv("Thread::Specific::FIELDS", TRUE, SVt_PVHV);
+	    av_store(thr->specific, 0, newRV((SV*)GvHV(gv)));
+	}
+	XPUSHs(sv_bless(newRV((SV*)thr->specific),gv_stashpv(classname,TRUE)));
+#endif
diff --git a/contrib/perl5/ext/Thread/Thread/Queue.pm b/contrib/perl5/ext/Thread/Thread/Queue.pm
new file mode 100644
index 0000000..6d5f82b
--- /dev/null
+++ b/contrib/perl5/ext/Thread/Thread/Queue.pm
@@ -0,0 +1,99 @@
+package Thread::Queue;
+use Thread qw(cond_wait cond_broadcast);
+
+=head1 NAME
+
+Thread::Queue - thread-safe queues
+
+=head1 SYNOPSIS
+
+    use Thread::Queue;
+    my $q = new Thread::Queue;
+    $q->enqueue("foo", "bar");
+    my $foo = $q->dequeue;    # The "bar" is still in the queue.
+    my $foo = $q->dequeue_nb; # returns "bar", or undef if the queue was
+                              # empty
+    my $left = $q->pending;   # returns the number of items still in the queue
+
+=head1 DESCRIPTION
+
+A queue, as implemented by C<Thread::Queue> is a thread-safe data structure
+much like a list. Any number of threads can safely add elements to the end
+of the list, or remove elements from the head of the list. (Queues don't
+permit adding or removing elements from the middle of the list)
+
+=head1 FUNCTIONS AND METHODS
+
+=over 8
+
+=item new
+
+The C<new> function creates a new empty queue.
+
+=item enqueue LIST
+
+The C<enqueue> method adds a list of scalars on to the end of the queue.
+The queue will grow as needed to accomodate the list.
+
+=item dequeue
+
+The C<dequeue> method removes a scalar from the head of the queue and
+returns it. If the queue is currently empty, C<dequeue> will block the
+thread until another thread C<enqueue>s a scalar.
+
+=item dequeue_nb
+
+The C<dequeue_nb> method, like the C<dequeue> method, removes a scalar from
+the head of the queue and returns it. Unlike C<dequeue>, though,
+C<dequeue_nb> won't block if the queue is empty, instead returning
+C<undef>.
+
+=item pending
+
+The C<pending> method returns the number of items still in the queue.  (If
+there can be multiple readers on the queue it's best to lock the queue
+before checking to make sure that it stays in a consistent state)
+
+=back
+
+=head1 SEE ALSO
+
+L<Thread>
+  
+=cut
+
+sub new {
+    my $class = shift;
+    return bless [@_], $class;
+}
+
+sub dequeue {
+    use attrs qw(locked method);
+    my $q = shift;
+    cond_wait $q until @$q;
+    return shift @$q;
+}
+
+sub dequeue_nb {
+  use attrs qw(locked method);
+  my $q = shift;
+  if (@$q) {
+    return shift @$q;
+  } else {
+    return undef;
+  }
+}
+
+sub enqueue {
+    use attrs qw(locked method);
+    my $q = shift;
+    push(@$q, @_) and cond_broadcast $q;
+}
+
+sub pending {
+  use attrs qw(locked method);
+  my $q = shift;
+  return scalar(@$q);
+}
+
+1;
diff --git a/contrib/perl5/ext/Thread/Thread/Semaphore.pm b/contrib/perl5/ext/Thread/Thread/Semaphore.pm
new file mode 100644
index 0000000..915808c
--- /dev/null
+++ b/contrib/perl5/ext/Thread/Thread/Semaphore.pm
@@ -0,0 +1,87 @@
+package Thread::Semaphore;
+use Thread qw(cond_wait cond_broadcast);
+
+=head1 NAME
+
+Thread::Semaphore - thread-safe semaphores
+
+=head1 SYNOPSIS
+
+    use Thread::Semaphore;
+    my $s = new Thread::Semaphore;
+    $s->up;	# Also known as the semaphore V -operation.
+    # The guarded section is here
+    $s->down;	# Also known as the semaphore P -operation.
+
+    # The default semaphore value is 1.
+    my $s = new Thread::Semaphore($initial_value);
+    $s->up($up_value);
+    $s->down($up_value);
+
+=head1 DESCRIPTION
+
+Semaphores provide a mechanism to regulate access to resources. Semaphores,
+unlike locks, aren't tied to particular scalars, and so may be used to
+control access to anything you care to use them for.
+
+Semaphores don't limit their values to zero or one, so they can be used to
+control access to some resource that may have more than one of. (For
+example, filehandles) Increment and decrement amounts aren't fixed at one
+either, so threads can reserve or return multiple resources at once.
+
+=head1 FUNCTIONS AND METHODS
+
+=over 8
+
+=item new
+
+=item new NUMBER
+
+C<new> creates a new semaphore, and initializes its count to the passed
+number. If no number is passed, the semaphore's count is set to one.
+
+=item down
+
+=item down NUMBER
+
+The C<down> method decreases the semaphore's count by the specified number,
+or one if no number has been specified. If the semaphore's count would drop
+below zero, this method will block until such time that the semaphore's
+count is equal to or larger than the amount you're C<down>ing the
+semaphore's count by.
+
+=item up
+
+=item up NUMBER
+
+The C<up> method increases the semaphore's count by the number specified,
+or one if no number's been specified. This will unblock any thread blocked
+trying to C<down> the semaphore if the C<up> raises the semaphore count
+above what the C<down>s are trying to decrement it by.
+
+=back
+
+=cut
+
+sub new {
+    my $class = shift;
+    my $val = @_ ? shift : 1;
+    bless \$val, $class;
+}
+
+sub down {
+    use attrs qw(locked method);
+    my $s = shift;
+    my $inc = @_ ? shift : 1;
+    cond_wait $s until $$s >= $inc;
+    $$s -= $inc;
+}
+
+sub up {
+    use attrs qw(locked method);
+    my $s = shift;
+    my $inc = @_ ? shift : 1;
+    ($$s += $inc) > 0 and cond_broadcast $s;
+}
+
+1;
diff --git a/contrib/perl5/ext/Thread/Thread/Signal.pm b/contrib/perl5/ext/Thread/Thread/Signal.pm
new file mode 100644
index 0000000..f5f03db
--- /dev/null
+++ b/contrib/perl5/ext/Thread/Thread/Signal.pm
@@ -0,0 +1,50 @@
+package Thread::Signal;
+use Thread qw(async);
+
+=head1 NAME
+
+Thread::Signal - Start a thread which runs signal handlers reliably
+
+=head1 SYNOPSIS
+
+    use Thread::Signal;
+
+    $SIG{HUP} = \&some_handler;
+
+=head1 DESCRIPTION
+
+The C<Thread::Signal> module starts up a special signal handler thread.
+All signals to the process are delivered to it and it runs the
+associated C<$SIG{FOO}> handlers for them. Without this module,
+signals arriving at inopportune moments (such as when perl's internals
+are in the middle of updating critical structures) cause the perl
+code of the handler to be run unsafely which can cause memory corruption
+or worse.
+
+=head1 BUGS
+
+This module changes the semantics of signal handling slightly in that
+the signal handler is run separately from the main thread (and in
+parallel with it). This means that tricks such as calling C<die> from
+a signal handler behave differently (and, in particular, can't be
+used to exit directly from a system call).
+
+=cut
+
+if (!init_thread_signals()) {
+    require Carp;
+    Carp::croak("init_thread_signals failed: $!");
+}
+
+async {
+    my $sig;
+    while ($sig = await_signal()) {
+	&$sig();
+    }
+};
+
+END {
+    kill_sighandler_thread();
+}
+
+1;
diff --git a/contrib/perl5/ext/Thread/Thread/Specific.pm b/contrib/perl5/ext/Thread/Thread/Specific.pm
new file mode 100644
index 0000000..9c8a66a
--- /dev/null
+++ b/contrib/perl5/ext/Thread/Thread/Specific.pm
@@ -0,0 +1,29 @@
+package Thread::Specific;
+
+=head1 NAME
+
+Thread::Specific - thread-specific keys
+
+=head1 SYNOPSIS
+
+    use Thread::Specific;
+    my $k = key_create Thread::Specific;
+
+=head1 DESCRIPTION
+
+C<key_create> returns a unique thread-specific key.
+
+=cut
+
+sub import {
+    use attrs qw(locked method);
+    require fields;
+    fields->import(@_);
+}	
+
+sub key_create {
+    use attrs qw(locked method);
+    return ++$FIELDS{__MAX__};
+}
+
+1;
diff --git a/contrib/perl5/ext/Thread/create.t b/contrib/perl5/ext/Thread/create.t
new file mode 100644
index 0000000..7d6d189
--- /dev/null
+++ b/contrib/perl5/ext/Thread/create.t
@@ -0,0 +1,17 @@
+use Thread;
+sub start_here {
+    my $i;
+    print "In start_here with args: @_\n";
+    for ($i = 1; $i <= 5; $i++) {
+	print "start_here: $i\n";
+	sleep 1;
+    }
+}
+
+print "Starting new thread now\n";
+$t = new Thread \&start_here, qw(foo bar baz);
+print "Started thread $t\n";
+for ($count = 1; $count <= 5; $count++) {
+    print "main: $count\n";
+    sleep 1;
+}
diff --git a/contrib/perl5/ext/Thread/die.t b/contrib/perl5/ext/Thread/die.t
new file mode 100644
index 0000000..6239405
--- /dev/null
+++ b/contrib/perl5/ext/Thread/die.t
@@ -0,0 +1,16 @@
+use Thread 'async';
+
+$t = async {
+    print "here\n";
+    die "success";
+    print "shouldn't get here\n";
+};
+
+sleep 1;
+print "joining...\n";
+eval { @r = $t->join; };
+if ($@) {
+    print "thread died with message: $@";
+} else {
+    print "thread failed to die successfully\n";
+}
diff --git a/contrib/perl5/ext/Thread/die2.t b/contrib/perl5/ext/Thread/die2.t
new file mode 100644
index 0000000..f6b6955
--- /dev/null
+++ b/contrib/perl5/ext/Thread/die2.t
@@ -0,0 +1,16 @@
+use Thread 'async';
+
+$t = async {
+    sleep 1;
+    print "here\n";
+    die "success if preceded by 'thread died...'";
+    print "shouldn't get here\n";
+};
+
+print "joining...\n";
+@r = eval { $t->join; };
+if ($@) {
+    print "thread died with message: $@";
+} else {
+    print "thread failed to die successfully\n";
+}
diff --git a/contrib/perl5/ext/Thread/io.t b/contrib/perl5/ext/Thread/io.t
new file mode 100644
index 0000000..6012008
--- /dev/null
+++ b/contrib/perl5/ext/Thread/io.t
@@ -0,0 +1,39 @@
+use Thread;
+
+sub counter {
+$count = 10;
+while ($count--) {
+    sleep 1;
+    print "ping $count\n";
+}
+}
+
+sub reader {
+    my $line;
+    while ($line = <STDIN>) {
+	print "reader: $line";
+    }
+    print "End of input in reader\n";
+    return 0;
+}
+
+print <<'EOT';
+This test starts up a thread to read and echo whatever is typed on
+the keyboard/stdin, line by line, while the main thread counts down
+to zero. The test stays running until both the main thread has
+finished counting down and the I/O thread has seen end-of-file on
+the terminal/stdin.
+EOT
+
+$r = new Thread \&counter;
+
+&reader;
+
+__END__
+
+
+$count = 10;
+while ($count--) {
+    sleep 1;
+    print "ping $count\n";
+}
diff --git a/contrib/perl5/ext/Thread/join.t b/contrib/perl5/ext/Thread/join.t
new file mode 100644
index 0000000..cba2c1c
--- /dev/null
+++ b/contrib/perl5/ext/Thread/join.t
@@ -0,0 +1,11 @@
+use Thread;
+sub foo {
+    print "In foo with args: @_\n";
+    return (7, 8, 9);
+}
+
+print "Starting thread\n";
+$t = new Thread \&foo, qw(foo bar baz);
+print "Joining with $t\n";
+@results = $t->join();
+print "Joining returned ", scalar(@results), " values: @results\n";
diff --git a/contrib/perl5/ext/Thread/join2.t b/contrib/perl5/ext/Thread/join2.t
new file mode 100644
index 0000000..99b43a5
--- /dev/null
+++ b/contrib/perl5/ext/Thread/join2.t
@@ -0,0 +1,12 @@
+use Thread;
+sub foo {
+    print "In foo with args: @_\n";
+    return (7, 8, 9);
+}
+
+print "Starting thread\n";
+$t = new Thread \&foo, qw(foo bar baz);
+sleep 2;
+print "Joining with $t\n";
+@results = $t->join();
+print "Joining returned @results\n";
diff --git a/contrib/perl5/ext/Thread/list.t b/contrib/perl5/ext/Thread/list.t
new file mode 100644
index 0000000..f13f4b2
--- /dev/null
+++ b/contrib/perl5/ext/Thread/list.t
@@ -0,0 +1,30 @@
+use Thread qw(async);
+use Thread::Semaphore;
+
+my $sem = Thread::Semaphore->new(0);
+
+$nthreads = 4;
+
+for (my $i = 0; $i < $nthreads; $i++) {
+    async {
+     	my $tid = Thread->self->tid;
+	print "thread $tid started...\n";
+	$sem->down;
+	print "thread $tid finishing\n";
+    };
+}
+
+print "main: started $nthreads threads\n";
+sleep 2;
+
+my @list = Thread->list;
+printf "main: Thread->list returned %d threads\n", scalar(@list);
+
+foreach my $t (@list) {
+    print "inspecting thread $t...\n";
+    print "...deref is $$t\n";
+    print "...flags = ", $t->flags, "\n";
+    print "...tid = ", $t->tid, "\n";
+}
+print "main thread telling workers to finish off...\n";
+$sem->up($nthreads);
diff --git a/contrib/perl5/ext/Thread/lock.t b/contrib/perl5/ext/Thread/lock.t
new file mode 100644
index 0000000..fefb129
--- /dev/null
+++ b/contrib/perl5/ext/Thread/lock.t
@@ -0,0 +1,27 @@
+use Thread;
+
+$level = 0;
+
+sub worker
+{
+    my $num = shift;
+    my $i;
+    print "thread $num starting\n";
+    for ($i = 1; $i <= 20; $i++) {
+	print "thread $num iteration $i\n";
+	select(undef, undef, undef, rand(10)/100);
+	{
+	    lock($lock);
+	    warn "thread $num saw non-zero level = $level\n" if $level;
+	    $level++;
+	    print "thread $num has lock\n";
+	    select(undef, undef, undef, rand(10)/100);
+	    $level--;
+	}
+	print "thread $num released lock\n";
+    }
+}
+
+for ($t = 1; $t <= 5; $t++) {
+    new Thread \&worker, $t;
+}
diff --git a/contrib/perl5/ext/Thread/queue.t b/contrib/perl5/ext/Thread/queue.t
new file mode 100644
index 0000000..4672ba6
--- /dev/null
+++ b/contrib/perl5/ext/Thread/queue.t
@@ -0,0 +1,36 @@
+use Thread;
+use Thread::Queue;
+
+$q = new Thread::Queue;
+
+sub reader {
+    my $tid = Thread->self->tid;
+    my $i = 0;
+    while (1) {
+	$i++;
+	print "reader (tid $tid): waiting for element $i...\n";
+	my $el = $q->dequeue;
+	print "reader (tid $tid): dequeued element $i: value $el\n";
+	select(undef, undef, undef, rand(2));
+	if ($el == -1) {
+	    # end marker
+	    print "reader (tid $tid) returning\n";
+	    return;
+	}
+    }
+}
+
+my $nthreads = 3;
+
+for (my $i = 0; $i < $nthreads; $i++) {
+    Thread->new(\&reader, $i);
+}
+
+for (my $i = 1; $i <= 10; $i++) {
+    my $el = int(rand(100));
+    select(undef, undef, undef, rand(2));
+    print "writer: enqueuing value $el\n";
+    $q->enqueue($el);
+}
+
+$q->enqueue((-1) x $nthreads); # one end marker for each thread
diff --git a/contrib/perl5/ext/Thread/specific.t b/contrib/perl5/ext/Thread/specific.t
new file mode 100644
index 0000000..da130b1
--- /dev/null
+++ b/contrib/perl5/ext/Thread/specific.t
@@ -0,0 +1,17 @@
+use Thread;
+
+use Thread::Specific qw(foo);
+
+sub count {
+    my $tid = Thread->self->tid;
+    my Thread::Specific $tsd = Thread::Specific::data;
+    for (my $i = 0; $i < 5; $i++) {
+	$tsd->{foo} = $i;
+	print "thread $tid count: $tsd->{foo}\n";
+	select(undef, undef, undef, rand(2));
+    }
+};
+
+for(my $t = 0; $t < 5; $t++) {
+    new Thread \&count;
+}
diff --git a/contrib/perl5/ext/Thread/sync.t b/contrib/perl5/ext/Thread/sync.t
new file mode 100644
index 0000000..9c2e589
--- /dev/null
+++ b/contrib/perl5/ext/Thread/sync.t
@@ -0,0 +1,61 @@
+use Thread;
+
+$level = 0;
+
+sub single_file {
+    use attrs 'locked';
+    my $arg = shift;
+    $level++;
+    print "Level $level for $arg\n";
+    print "(something is wrong)\n" if $level < 0 || $level > 1;
+    sleep 1;
+    $level--;
+    print "Back to level $level\n";
+}
+
+sub start_bar {
+    my $i;
+    print "start bar\n";
+    for $i (1..3) {
+	print "bar $i\n";
+	single_file("bar $i");
+	sleep 1 if rand > 0.5;
+    }
+    print "end bar\n";
+    return 1;
+}
+
+sub start_foo {
+    my $i;
+    print "start foo\n";
+    for $i (1..3) {
+	print "foo $i\n";
+	single_file("foo $i");
+	sleep 1 if rand > 0.5;
+    }
+    print "end foo\n";
+    return 1;
+}
+
+sub start_baz {
+    my $i;
+    print "start baz\n";
+    for $i (1..3) {
+	print "baz $i\n";
+	single_file("baz $i");
+	sleep 1 if rand > 0.5;
+    }
+    print "end baz\n";
+    return 1;
+}
+
+$| = 1;
+srand($$^$^T);
+
+$foo = new Thread \&start_foo;
+$bar = new Thread \&start_bar;
+$baz = new Thread \&start_baz;
+$foo->join();
+$bar->join();
+$baz->join();
+print "main: threads finished, exiting\n";
diff --git a/contrib/perl5/ext/Thread/sync2.t b/contrib/perl5/ext/Thread/sync2.t
new file mode 100644
index 0000000..0901da4
--- /dev/null
+++ b/contrib/perl5/ext/Thread/sync2.t
@@ -0,0 +1,69 @@
+use Thread;
+
+$global = undef;
+
+sub single_file {
+    use attrs 'locked';
+    my $who = shift;
+    my $i;
+
+    print "Uh oh: $who entered while locked by $global\n" if $global;
+    $global = $who;
+    print "[";
+    for ($i = 0; $i < int(10 * rand); $i++) {
+	print $who;
+	select(undef, undef, undef, 0.1);
+    }
+    print "]";
+    $global = undef;
+}
+
+sub start_a {
+    my ($i, $j);
+    for ($j = 0; $j < 10; $j++) {
+	single_file("A");
+	for ($i = 0; $i < int(10 * rand); $i++) {
+	    print "a";
+	    select(undef, undef, undef, 0.1);
+	}
+    }
+}
+
+sub start_b {
+    my ($i, $j);
+    for ($j = 0; $j < 10; $j++) {
+	single_file("B");
+	for ($i = 0; $i < int(10 * rand); $i++) {
+	    print "b";
+	    select(undef, undef, undef, 0.1);
+	}
+    }
+}
+
+sub start_c {
+    my ($i, $j);
+    for ($j = 0; $j < 10; $j++) {
+	single_file("C");
+	for ($i = 0; $i < int(10 * rand); $i++) {
+	    print "c";
+	    select(undef, undef, undef, 0.1);
+	}
+    }
+}
+
+$| = 1;
+srand($$^$^T);
+
+print <<'EOT';
+Each pair of square brackets [...] should contain a repeated sequence of
+a unique upper case letter. Lower case letters may appear randomly both
+in and out of the brackets.
+EOT
+$foo = new Thread \&start_a;
+$bar = new Thread \&start_b;
+$baz = new Thread \&start_c;
+print "\nmain: joining...\n";
+#$foo->join;
+#$bar->join;
+#$baz->join;
+print "\ndone\n";
diff --git a/contrib/perl5/ext/Thread/typemap b/contrib/perl5/ext/Thread/typemap
new file mode 100644
index 0000000..21eb6c3
--- /dev/null
+++ b/contrib/perl5/ext/Thread/typemap
@@ -0,0 +1,24 @@
+Thread		T_XSCPTR
+
+INPUT
+T_XSCPTR
+	STMT_START {
+	    MAGIC *mg;
+	    SV *sv = ($arg);
+
+	    if (!sv_isobject(sv))
+		croak(\"$var is not an object\");
+	    sv = (SV*)SvRV(sv);
+	    if (!SvRMAGICAL(sv) || !(mg = mg_find(sv, '~'))
+		|| mg->mg_private != ${ntype}_MAGIC_SIGNATURE)
+		croak(\"XSUB ${func_name}: $var is a forged ${ntype} object\");
+	    $var = ($type) SvPVX(mg->mg_obj);
+	    DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+				  \"XSUB ${func_name}: %p\\n\", $var);)
+	} STMT_END
+T_IVREF
+	if (SvROK($arg))
+	    $var = ($type) SvIV((SV*)SvRV($arg));
+	else
+	    croak(\"$var is not a reference\")
+
diff --git a/contrib/perl5/ext/Thread/unsync.t b/contrib/perl5/ext/Thread/unsync.t
new file mode 100644
index 0000000..f0a51ef
--- /dev/null
+++ b/contrib/perl5/ext/Thread/unsync.t
@@ -0,0 +1,37 @@
+use Thread;
+
+$| = 1;
+
+if (@ARGV) {
+    srand($ARGV[0]);
+} else {
+    my $seed = $$ ^ $^T;
+    print "Randomising to $seed\n";
+    srand($seed);
+}
+
+sub whoami {
+    my ($depth, $a, $b, $c) = @_;
+    my $i;
+    print "whoami ($depth): $a $b $c\n";
+    sleep 1;
+    whoami($depth - 1, $a, $b, $c) if $depth > 0;
+}
+
+sub start_foo {
+    my $r = 3 + int(10 * rand);
+    print "start_foo: r is $r\n";
+    whoami($r, "start_foo", "foo1", "foo2");
+    print "start_foo: finished\n";
+}
+
+sub start_bar {
+    my $r = 3 + int(10 * rand);
+    print "start_bar: r is $r\n";
+    whoami($r, "start_bar", "bar1", "bar2");
+    print "start_bar: finished\n";
+}
+
+$foo = new Thread \&start_foo;
+$bar = new Thread \&start_bar;
+print "main: exiting\n";
diff --git a/contrib/perl5/ext/Thread/unsync2.t b/contrib/perl5/ext/Thread/unsync2.t
new file mode 100644
index 0000000..fb955ac
--- /dev/null
+++ b/contrib/perl5/ext/Thread/unsync2.t
@@ -0,0 +1,36 @@
+use Thread;
+
+$| = 1;
+
+srand($$^$^T);
+
+sub printargs {
+    my $thread = shift;
+    my $arg;
+    my $i;
+    while ($arg = shift) {
+	my $delay = int(rand(500));
+	$i++;
+	print "$thread arg $i is $arg\n";
+	1 while $delay--;
+    }
+}
+
+sub start_thread {
+    my $thread = shift;
+    my $count = 10;
+    while ($count--) {
+	my(@args) = ($thread) x int(rand(10));
+	print "$thread $count calling printargs @args\n";
+	printargs($thread, @args);
+    }
+}
+
+new Thread (\&start_thread, "A");
+new Thread (\&start_thread, "B");
+#new Thread (\&start_thread, "C");
+#new Thread (\&start_thread, "D");
+#new Thread (\&start_thread, "E");
+#new Thread (\&start_thread, "F");
+
+print "main: exiting\n";
diff --git a/contrib/perl5/ext/Thread/unsync3.t b/contrib/perl5/ext/Thread/unsync3.t
new file mode 100644
index 0000000..e03e9c8
--- /dev/null
+++ b/contrib/perl5/ext/Thread/unsync3.t
@@ -0,0 +1,50 @@
+use Thread;
+
+$| = 1;
+
+srand($$^$^T);
+
+sub whoami {
+    my $thread = shift;
+    print $thread;
+}
+
+sub uppercase {
+    my $count = 100;
+    while ($count--) {
+	my $i = int(rand(1000));
+	1 while $i--;
+	print "A";
+	$i = int(rand(1000));
+	1 while $i--;
+	whoami("B");
+    }
+}
+	
+sub lowercase {
+    my $count = 100;
+    while ($count--) {
+	my $i = int(rand(1000));
+	1 while $i--;
+	print "x";
+	$i = int(rand(1000));
+	1 while $i--;
+	whoami("y");
+    }
+}
+	
+sub numbers {
+    my $count = 100;
+    while ($count--) {
+	my $i = int(rand(1000));
+	1 while $i--;
+	print 1;
+	$i = int(rand(1000));
+	1 while $i--;
+	whoami(2);
+    }
+}
+	
+new Thread \&numbers;
+new Thread \&uppercase;
+new Thread \&lowercase;
diff --git a/contrib/perl5/ext/Thread/unsync4.t b/contrib/perl5/ext/Thread/unsync4.t
new file mode 100644
index 0000000..494ad2b
--- /dev/null
+++ b/contrib/perl5/ext/Thread/unsync4.t
@@ -0,0 +1,38 @@
+use Thread;
+
+$| = 1;
+
+srand($$^$^T);
+
+sub printargs {
+    my(@copyargs) = @_;
+    my $thread = shift @copyargs;
+    my $arg;
+    my $i;
+    while ($arg = shift @copyargs) {
+	my $delay = int(rand(500));
+	$i++;
+	print "$thread arg $i is $arg\n";
+	1 while $delay--;
+    }
+}
+
+sub start_thread {
+    my(@threadargs) = @_;
+    my $thread = $threadargs[0];
+    my $count = 10;
+    while ($count--) {
+	my(@args) = ($thread) x int(rand(10));
+	print "$thread $count calling printargs @args\n";
+	printargs($thread, @args);
+    }
+}
+
+new Thread (\&start_thread, "A");
+new Thread (\&start_thread, "B");
+new Thread (\&start_thread, "C");
+new Thread (\&start_thread, "D");
+new Thread (\&start_thread, "E");
+new Thread (\&start_thread, "F");
+
+print "main: exiting\n";
diff --git a/contrib/perl5/ext/attrs/Makefile.PL b/contrib/perl5/ext/attrs/Makefile.PL
new file mode 100644
index 0000000..c421757
--- /dev/null
+++ b/contrib/perl5/ext/attrs/Makefile.PL
@@ -0,0 +1,7 @@
+use ExtUtils::MakeMaker;
+WriteMakefile(
+    NAME	=> 'attrs',
+    VERSION_FROM => 'attrs.pm',
+    MAN3PODS 	=> ' ', 	# Pods will be built by installman.
+    XSPROTOARG => '-noprototypes'
+);
diff --git a/contrib/perl5/ext/attrs/attrs.pm b/contrib/perl5/ext/attrs/attrs.pm
new file mode 100644
index 0000000..fe2bf35
--- /dev/null
+++ b/contrib/perl5/ext/attrs/attrs.pm
@@ -0,0 +1,55 @@
+package attrs;
+require DynaLoader;
+use vars '@ISA';
+@ISA = 'DynaLoader';
+
+use vars qw($VERSION);
+$VERSION = "1.0";
+
+=head1 NAME
+
+attrs - set/get attributes of a subroutine
+
+=head1 SYNOPSIS
+
+    sub foo {
+        use attrs qw(locked method);
+        ...
+    }
+
+    @a = attrs::get(\&foo);
+
+=head1 DESCRIPTION
+
+This module lets you set and get attributes for subroutines.
+Setting attributes takes place at compile time; trying to set
+invalid attribute names causes a compile-time error. Calling
+C<attr::get> on a subroutine reference or name returns its list
+of attribute names. Notice that C<attr::get> is not exported.
+Valid attributes are as follows.
+
+=over
+
+=item method
+
+Indicates that the invoking subroutine is a method.
+
+=item locked
+
+Setting this attribute is only meaningful when the subroutine or
+method is to be called by multiple threads. When set on a method
+subroutine (i.e. one marked with the B<method> attribute above),
+perl ensures that any invocation of it implicitly locks its first
+argument before execution. When set on a non-method subroutine,
+perl ensures that a lock is taken on the subroutine itself before
+execution. The semantics of the lock are exactly those of one
+explicitly taken with the C<lock> operator immediately after the
+subroutine is entered.
+
+=back
+
+=cut
+
+bootstrap attrs $VERSION;
+
+1;
diff --git a/contrib/perl5/ext/attrs/attrs.xs b/contrib/perl5/ext/attrs/attrs.xs
new file mode 100644
index 0000000..da952d5
--- /dev/null
+++ b/contrib/perl5/ext/attrs/attrs.xs
@@ -0,0 +1,59 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+static cv_flags_t
+get_flag(char *attr)
+{
+    if (strnEQ(attr, "method", 6))
+	return CVf_METHOD;
+    else if (strnEQ(attr, "locked", 6))
+	return CVf_LOCKED;
+    else
+	return 0;
+}
+
+MODULE = attrs		PACKAGE = attrs
+
+void
+import(Class, ...)
+char *	Class
+    ALIAS:
+	unimport = 1
+    PREINIT:
+	int i;
+	CV *cv;
+    PPCODE:
+	if (!PL_compcv || !(cv = CvOUTSIDE(PL_compcv)))
+	    croak("can't set attributes outside a subroutine scope");
+	for (i = 1; i < items; i++) {
+	    char *attr = SvPV(ST(i), PL_na);
+	    cv_flags_t flag = get_flag(attr);
+	    if (!flag)
+		croak("invalid attribute name %s", attr);
+	    if (ix)
+    		CvFLAGS(cv) &= ~flag;
+	    else
+		CvFLAGS(cv) |= flag;
+	}
+
+void
+get(sub)
+SV *	sub
+    PPCODE:
+	if (SvROK(sub)) {
+	    sub = SvRV(sub);
+	    if (SvTYPE(sub) != SVt_PVCV)
+		sub = Nullsv;
+	}
+	else {
+	    char *name = SvPV(sub, PL_na);
+	    sub = (SV*)perl_get_cv(name, FALSE);
+	}
+	if (!sub)
+	    croak("invalid subroutine reference or name");
+	if (CvFLAGS(sub) & CVf_METHOD)
+	    XPUSHs(sv_2mortal(newSVpv("method", 0)));
+	if (CvFLAGS(sub) & CVf_LOCKED)
+	    XPUSHs(sv_2mortal(newSVpv("locked", 0)));
+
diff --git a/contrib/perl5/ext/re/Makefile.PL b/contrib/perl5/ext/re/Makefile.PL
new file mode 100644
index 0000000..9ed83d1
--- /dev/null
+++ b/contrib/perl5/ext/re/Makefile.PL
@@ -0,0 +1,41 @@
+use ExtUtils::MakeMaker;
+WriteMakefile(
+    NAME		=> 're',
+    VERSION_FROM	=> 're.pm',
+    MAN3PODS		=> ' ', 	# Pods will be built by installman.
+    XSPROTOARG		=> '-noprototypes',
+    OBJECT		=> 're_exec$(OBJ_EXT) re_comp$(OBJ_EXT) re$(OBJ_EXT)',
+    DEFINE		=> '-DPERL_EXT_RE_BUILD',
+    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)
+
+re_comp$(OBJ_EXT) : re_comp.c
+
+re_exec.c : [--]regexec.c
+	- $(RM_F) $(MMS$TARGET_NAME)
+	$(CP) [--]regexec.c $(MMS$TARGET_NAME)
+
+re_exec$(OBJ_EXT) : re_exec.c
+
+
+VMS_EOF
+  } else {
+    return <<'EOF';
+re_comp.c: ../../regcomp.c
+	-$(RM_F) $@
+	$(CP) ../../regcomp.c $@
+
+re_exec.c: ../../regexec.c
+	-$(RM_F) $@
+	$(CP) ../../regexec.c $@
+
+EOF
+  }
+}
diff --git a/contrib/perl5/ext/re/hints/mpeix.pl b/contrib/perl5/ext/re/hints/mpeix.pl
new file mode 100644
index 0000000..d1fbb91
--- /dev/null
+++ b/contrib/perl5/ext/re/hints/mpeix.pl
@@ -0,0 +1,3 @@
+# Fall back to -O optimization to avoid known gcc 2.8.0 -O2 problems on MPE/iX.
+#  Mark Bixby <markb@cccd.edu>
+$self->{OPTIMIZE} = '-O';
diff --git a/contrib/perl5/ext/re/re.pm b/contrib/perl5/ext/re/re.pm
new file mode 100644
index 0000000..7cea77d
--- /dev/null
+++ b/contrib/perl5/ext/re/re.pm
@@ -0,0 +1,131 @@
+package re;
+
+$VERSION = 0.02;
+
+=head1 NAME
+
+re - Perl pragma to alter regular expression behaviour
+
+=head1 SYNOPSIS
+
+    use re 'taint';
+    ($x) = ($^X =~ /^(.*)$/s);     # $x is tainted here
+
+    $pat = '(?{ $foo = 1 })';
+    use re 'eval';
+    /foo${pat}bar/;		   # won't fail (when not under -T switch)
+
+    {
+	no re 'taint';		   # the default
+	($x) = ($^X =~ /^(.*)$/s); # $x is not tainted here
+
+	no re 'eval';		   # the default
+	/foo${pat}bar/;		   # disallowed (with or without -T switch)
+    }
+
+    use re 'debug';		   # NOT lexically scoped (as others are)
+    /^(.*)$/s;			   # output debugging info during
+    				   #     compile and run time
+
+    use re 'debugcolor';	   # same as 'debug', but with colored output
+    ...
+
+(We use $^X in these examples because it's tainted by default.)
+
+=head1 DESCRIPTION
+
+When C<use re 'taint'> is in effect, and a tainted string is the target
+of a regex, the regex memories (or values returned by the m// operator
+in list context) are tainted.  This feature is useful when regex operations
+on tainted data aren't meant to extract safe substrings, but to perform
+other transformations.
+
+When C<use re 'eval'> is in effect, a regex is allowed to contain
+C<(?{ ... })> zero-width assertions even if regular expression contains
+variable interpolation.  That is normally disallowed, since it is a 
+potential security risk.  Note that this pragma is ignored when the regular
+expression is obtained from tainted data, i.e.  evaluation is always
+disallowed with tainted regular expresssions.  See L<perlre/(?{ code })>.
+
+For the purpose of this pragma, interpolation of precompiled regular 
+expressions (i.e., the result of C<qr//>) is I<not> considered variable
+interpolation.  Thus:
+
+    /foo${pat}bar/
+
+I<is> allowed if $pat is a precompiled regular expression, even 
+if $pat contains C<(?{ ... })> assertions.
+
+When C<use re 'debug'> is in effect, perl emits debugging messages when 
+compiling and using regular expressions.  The output is the same as that
+obtained by running a C<-DDEBUGGING>-enabled perl interpreter with the
+B<-Dr> switch. It may be quite voluminous depending on the complexity
+of the match.  Using C<debugcolor> instead of C<debug> enables a
+form of output that can be used to get a colorful display on terminals
+that understand termcap color sequences.  Set C<$ENV{PERL_RE_TC}> to a
+comma-separated list of C<termcap> properties to use for highlighting
+strings on/off, pre-point part on/off.  
+See L<perldebug/"Debugging regular expressions"> for additional info.
+
+The directive C<use re 'debug'> is I<not lexically scoped>, as the
+other directives are.  It has both compile-time and run-time effects.
+
+See L<perlmodlib/Pragmatic Modules>.
+
+=cut
+
+my %bitmask = (
+taint	=> 0x00100000,
+eval	=> 0x00200000,
+);
+
+sub setcolor {
+ eval {				# Ignore errors
+  require Term::Cap;
+
+  my $terminal = Tgetent Term::Cap ({OSPEED => 9600}); # Avoid warning.
+  my $props = $ENV{PERL_RE_TC} || 'md,me,so,se'; # can use us/ue later
+  my @props = split /,/, $props;
+
+
+  $ENV{TERMCAP_COLORS} = join "\t", map {$terminal->Tputs($_,1)} @props;
+ };
+
+ not defined $ENV{TERMCAP_COLORS} or ($ENV{TERMCAP_COLORS} =~ tr/\t/\t/) >= 4
+    or not defined $ENV{PERL_RE_TC}
+    or die "Not enough fields in \$ENV{PERL_RE_TC}=`$ENV{PERL_RE_TC}'";
+}
+
+sub bits {
+    my $on = shift;
+    my $bits = 0;
+    unless(@_) {
+	require Carp;
+	Carp::carp("Useless use of \"re\" pragma");
+    }
+    foreach my $s (@_){
+      if ($s eq 'debug' or $s eq 'debugcolor') {
+ 	  setcolor() if $s eq 'debugcolor';
+	  require DynaLoader;
+	  @ISA = ('DynaLoader');
+	  bootstrap re;
+	  install() if $on;
+	  uninstall() unless $on;
+	  next;
+      }
+      $bits |= $bitmask{$s} || 0;
+    }
+    $bits;
+}
+
+sub import {
+    shift;
+    $^H |= bits(1,@_);
+}
+
+sub unimport {
+    shift;
+    $^H &= ~ bits(0,@_);
+}
+
+1;
diff --git a/contrib/perl5/ext/re/re.xs b/contrib/perl5/ext/re/re.xs
new file mode 100644
index 0000000..7230d62
--- /dev/null
+++ b/contrib/perl5/ext/re/re.xs
@@ -0,0 +1,46 @@
+/* We need access to debugger hooks */
+#ifndef DEBUGGING
+#  define DEBUGGING
+#endif
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+extern regexp*	my_regcomp _((char* exp, char* xend, PMOP* pm));
+extern I32	my_regexec _((regexp* prog, char* stringarg, char* strend,
+			      char* strbeg, I32 minend, SV* screamer,
+			      void* data, U32 flags));
+
+static int oldfl;
+
+#define R_DB 512
+
+static void
+deinstall(void)
+{
+    dTHR;
+    PL_regexecp = &regexec_flags;
+    PL_regcompp = &pregcomp;
+    if (!oldfl)
+	PL_debug &= ~R_DB;
+}
+
+static void
+install(void)
+{
+    dTHR;
+    PL_colorset = 0;			/* Allow reinspection of ENV. */
+    PL_regexecp = &my_regexec;
+    PL_regcompp = &my_regcomp;
+    oldfl = PL_debug & R_DB;
+    PL_debug |= R_DB;
+}
+
+MODULE = re	PACKAGE = re
+
+void
+install()
+
+void
+deinstall()
diff --git a/contrib/perl5/ext/util/make_ext b/contrib/perl5/ext/util/make_ext
new file mode 100644
index 0000000..54caf7d
--- /dev/null
+++ b/contrib/perl5/ext/util/make_ext
@@ -0,0 +1,141 @@
+#!/bin/sh
+
+# This script acts as a simple interface for building extensions.
+# It primarily used by the perl Makefile:
+#
+# d_dummy $(dynamic_ext): miniperl preplibrary FORCE
+# 	@sh ext/util/make_ext dynamic $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL)
+#
+# It may be deleted in a later release of perl so try to
+# avoid using it for other purposes.
+
+target=$1;  shift
+extspec=$1; shift
+makecmd=$1; shift  # Should be something like MAKE=make
+passthru="$*" # allow extra macro=value to be passed through
+echo ""
+
+# Previously, $make was taken from config.sh.  However, the user might
+# instead be running a possibly incompatible make.  This might happen if
+# the user types "gmake" instead of a plain "make", for example.  The
+# correct current value of MAKE will come through from the main perl
+# makefile as MAKE=/whatever/make in $makecmd.  We'll be cautious in
+# case third party users of this script (are there any?) don't have the
+# MAKE=$(MAKE) argument, which was added after 5.004_03.
+case "$makecmd" in
+MAKE=*)
+	eval $makecmd
+	;;
+*)	echo 'ext/util/make_ext:  WARNING:  Please include MAKE=$(MAKE)'
+	echo '	in your call to make_ext.  See ext/util/make_ext for details.'
+	exit 1
+	;;
+esac
+
+
+case $CONFIG in
+'')
+    if test -f config.sh; then TOP=.;
+    elif test -f ../config.sh; then TOP=..;
+    elif test -f ../../config.sh; then TOP=../..;
+    elif test -f ../../../config.sh; then TOP=../../..;
+    elif test -f ../../../../config.sh; then TOP=../../../..;
+    else
+        echo "Can't find config.sh generated by Configure"; exit 1
+    fi
+    . $TOP/config.sh
+    ;;
+esac
+
+if test "X$extspec" = X; then
+	echo "make_ext: no extension specified"
+	exit 1;
+fi
+
+# The Perl Makefile.SH will expand all extensions to
+#	lib/auto/X/X.a  (or lib/auto/X/Y/Y.a if nested)
+# A user wishing to run make_ext might use
+#	X (or X/Y or X::Y if nested)
+
+# canonise into X/Y form (pname)
+case "$extspec" in
+lib*)	# Remove lib/auto prefix and /*.* suffix
+	pname=`echo "$extspec" | sed -e 's:^lib/auto/::' -e 's:/[^/]*\.[^/]*$::' ` ;;
+ext*)	# Remove ext/ prefix and /pm_to_blib suffix
+	pname=`echo "$extspec" | sed -e 's:^ext/::' -e 's:/pm_to_blib$::' ` ;;
+*::*)	# Convert :: to /
+	pname=`echo "$extspec" | sed -e 's/::/\//g' ` ;;
+*)	pname="$extspec" ;;
+esac
+# echo "Converted $extspec to $pname"
+
+mname=`echo "$pname"   | sed -e 's!/!::!g'`
+depth=`echo "$pname"   | sed -e 's![^/][^/]*!..!g'`
+makefile=Makefile
+makeargs=''
+makeopts=''
+
+if test ! -d "ext/$pname"; then
+    echo "	Skipping $extspec (directory does not exist)"
+    exit 0 # not an error ?
+fi
+
+
+echo "	Making $mname ($target)"
+
+cd ext/$pname
+
+# check link type and do any preliminaries
+case "$target" in
+	    # convert 'static' or 'dynamic' into 'all LINKTYPE=XXX'
+static)     makeargs="LINKTYPE=static CCCDLFLAGS="
+	    target=all
+	    ;;
+dynamic)    makeargs="LINKTYPE=dynamic";
+	    target=all
+	    ;;
+
+nonxs)      makeargs="";
+	    target=all
+	    ;;
+
+*clean) # If Makefile has been moved to Makefile.old by a make clean
+	    # then use Makefile.old for realclean rather than rebuild it
+	    if test ! -f $makefile -a -f Makefile.old; then
+		makefile=Makefile.old
+		makeopts="-f $makefile"
+		echo "Note: Using Makefile.old"
+	    fi
+	    ;;
+
+*)	# for the time being we are strict about what make_ext is used for
+	echo "make_ext: unknown make target '$target'"; exit 1
+	;;
+'')	echo "make_ext: no make target specified (eg static or dynamic)"; exit 1
+	;;
+esac
+
+if test ! -f $makefile ; then
+	test -f Makefile.PL && ../$depth/miniperl -I../$depth/lib Makefile.PL INSTALLDIRS=perl $passthru
+fi
+if test ! -f $makefile ; then
+	if test -f Makefile.SH; then
+		echo "Warning: Writing $makefile from old-style Makefile.SH!"
+		sh Makefile.SH
+	else
+		echo "Warning: No Makefile!"
+	fi
+fi
+
+case "$target" in
+clean)		;;
+realclean)	;;
+*)	# Give makefile an opportunity to rewrite itself.
+	# reassure users that life goes on...
+	$MAKE config $passthru || echo "$MAKE config failed, continuing anyway..."
+	;;
+esac
+
+$MAKE $makeopts $target $makeargs $passthru || exit
+
+exit $?
diff --git a/contrib/perl5/ext/util/mkbootstrap b/contrib/perl5/ext/util/mkbootstrap
new file mode 100644
index 0000000..6c3a7e1
--- /dev/null
+++ b/contrib/perl5/ext/util/mkbootstrap
@@ -0,0 +1,5 @@
+#!../../miniperl -w -I../../lib
+
+use ExtUtils::MakeMaker;
+&mkbootstrap(join(" ",@ARGV));
+exit;